[flang] Add AllocatableInit functions for use in allocate lowering

`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`.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D146290

diff --git a/flang/include/flang/Runtime/allocatable.h b/flang/include/flang/Runtime/allocatable.h
index 58bbd27..4169483 100644 (file)
--- a/flang/include/flang/Runtime/allocatable.h
+++ b/flang/include/flang/Runtime/allocatable.h
@@ -33,6 +33,17 @@ void RTNAME(AllocatableInitCharacter)(Descriptor &, SubscriptValue length = 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.

diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
index 7d4f04c..758c814 100644 (file)
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -41,6 +41,30 @@ void RTNAME(AllocatableInitDerived)(Descriptor &descriptor,
       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) {

diff --git a/flang/unittests/Runtime/Allocatable.cpp b/flang/unittests/Runtime/Allocatable.cpp
index 8e1ec46..ed8e919 100644 (file)
--- a/flang/unittests/Runtime/Allocatable.cpp
+++ b/flang/unittests/Runtime/Allocatable.cpp
@@ -94,3 +94,20 @@ TEST(AllocatableTest, AllocateFromScalarSource) {
   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());
+}