[flang] Add AllocatableInit functions for use in allocate lowering

[clementval]

Summary

AllocatableInitIntrinsic, AllocatableInitCharacter and
AllocatableInitDerived are meant to be used to initialize a
descriptor when it is instantiated and not to be used multiple
times in a scope.
Add AllocatableInitDerivedForAllocate, AllocatableInitCharacterForAllocate
and AllocatableInitDerivedForAllocate to be used for the allocation
in allocate statement.
These new functions are meant to be used on an initialized descriptor
and will return directly if the descriptor is allocated so the
error handling is done by the call to AllocatableAllocate.

[PeteSteinfeld]

All builds and tests correctly and looks good.

Note that the x64 Debian build failed, but the failures don't seem related to this patch.

flang/include/flang/Runtime/allocatable.h

 // a change of type, rank, or corank.
 void RTNAME(AllocatableInitIntrinsic)(
     Descriptor &, TypeCategory, int kind, int rank = 0, int corank = 0);
 void RTNAME(AllocatableInitCharacter)(Descriptor &, SubscriptValue length = 0,
     int kind = 1, int rank = 0, int corank = 0);
 void RTNAME(AllocatableInitDerived)(
     Descriptor &, const typeInfo::DerivedType &, int rank = 0, int corank = 0);
 
+// Initializes the descriptor for an allocatable of intrinsic or derived type.
+// These functions are meant to be used in the allocate statement lowering. If
+// the descriptor is allocated, the initialization is skiped so the error
+// handling can be done by AllocatableAllocate.
+void RTNAME(AllocatableInitIntrinsicForAllocate)(
+    Descriptor &, TypeCategory, int kind, int rank = 0, int corank = 0);
+void RTNAME(AllocatableInitCharacterForAllocate)(Descriptor &,
+    SubscriptValue length = 0, int kind = 1, int rank = 0, int corank = 0);
+void RTNAME(AllocatableInitDerivedForAllocate)(
+    Descriptor &, const typeInfo::DerivedType &, int rank = 0, int corank = 0);
+
 // Checks that an allocatable is not already allocated in statements
 // with STAT=.  Use this on a value descriptor before setting bounds or
 // type parameters.  Not necessary on a freshly initialized descriptor.
 // (If there's no STAT=, the error will be caught later anyway, but
 // this API allows the error to be caught before descriptor is modified.)
 // Return 0 on success (deallocated state), else the STAT= value.
 int RTNAME(AllocatableCheckAllocated)(Descriptor &,
     const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,

flang/runtime/allocatable.cpp

 
 void RTNAME(AllocatableInitDerived)(Descriptor &descriptor,
     const typeInfo::DerivedType &derivedType, int rank, int corank) {
   INTERNAL_CHECK(corank == 0);
   descriptor.Establish(
       derivedType, nullptr, rank, nullptr, CFI_attribute_allocatable);
 }
 
+void RTNAME(AllocatableInitIntrinsicForAllocate)(Descriptor &descriptor,
+    TypeCategory category, int kind, int rank, int corank) {
+  if (descriptor.IsAllocated()) {
+    return;
+  }
+  RTNAME(AllocatableInitIntrinsic)(descriptor, category, kind, rank, corank);
+}
+
+void RTNAME(AllocatableInitCharacterForAllocate)(Descriptor &descriptor,
+    SubscriptValue length, int kind, int rank, int corank) {
+  if (descriptor.IsAllocated()) {
+    return;
+  }
+  RTNAME(AllocatableInitCharacter)(descriptor, length, kind, rank, corank);
+}
+
+void RTNAME(AllocatableInitDerivedForAllocate)(Descriptor &descriptor,
+    const typeInfo::DerivedType &derivedType, int rank, int corank) {
+  if (descriptor.IsAllocated()) {
+    return;
+  }
+  RTNAME(AllocatableInitDerived)(descriptor, derivedType, rank, corank);
+}
+
 std::int32_t RTNAME(MoveAlloc)(Descriptor &to, Descriptor &from,
     const typeInfo::DerivedType *derivedType, bool hasStat,
     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
 
   // If to and from are the same allocatable they must not be allocated
   // and nothing should be done.
   if (from.raw().base_addr == to.raw().base_addr && from.IsAllocated()) {

flang/unittests/Runtime/Allocatable.cpp

TEST(AllocatableTest, AllocateFromScalarSource) {
   (*a, *s, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
   EXPECT_TRUE(a->IsAllocated());
   EXPECT_EQ(a->Elements(), 10u);
   EXPECT_EQ(a->GetDimension(0).LowerBound(), 2);
   EXPECT_EQ(a->GetDimension(0).UpperBound(), 11);
   EXPECT_EQ(*a->OffsetElement<float>(), 3.4F);
   a->Destroy();
 }
+
+TEST(AllocatableTest, DoubleAllocation) {
+  // CLASS(*), ALLOCATABLE :: r
+  // ALLOCATE(REAL::r)
+  auto r{createAllocatable(TypeCategory::Real, 4, 0)};
+  EXPECT_FALSE(r->IsAllocated());
+  EXPECT_TRUE(r->IsAllocatable());
+  RTNAME(AllocatableAllocate)(*r);
+  EXPECT_TRUE(r->IsAllocated());
+
+  // Make sure AllocatableInitIntrinsicForAllocate doesn't reset the decsriptor
+  // if it is allocated.
+  // ALLOCATE(INTEGER::r)
+  RTNAME(AllocatableInitIntrinsicForAllocate)
+  (*r, Fortran::common::TypeCategory::Integer, 4);
+  EXPECT_TRUE(r->IsAllocated());
+}