[flang-commits] [flang] 52e2397 - [flang] Add AllocatableInit functions for use in allocate lowering

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-20T10:00:43+01:00
New Revision: 52e239794f35be6a68b2273f88a99d9207e77cab

URL: https://github.com/llvm/llvm-project/commit/52e239794f35be6a68b2273f88a99d9207e77cab
DIFF: https://github.com/llvm/llvm-project/commit/52e239794f35be6a68b2273f88a99d9207e77cab.diff

LOG: [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

Added: 
    

Modified: 
    flang/include/flang/Runtime/allocatable.h
    flang/runtime/allocatable.cpp
    flang/unittests/Runtime/Allocatable.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Runtime/allocatable.h b/flang/include/flang/Runtime/allocatable.h
index 58bbd27c1b97f..4169483398f6a 100644
--- 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 7d4f04cf48106..758c814025b96 100644
--- 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 8e1ec467b89f1..ed8e919320491 100644
--- 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());
+}