[flang-commits] [flang] [flang][runtime] Establish derived type desc properly. (PR #67623)

[Slava Zakharin via flang-commits]

https://github.com/vzakhari created https://github.com/llvm/llvm-project/pull/67623

Example:
```
module types
  type t
     real,allocatable :: c
  end type t
contains
  function h(x)
    class(t),allocatable :: h
    ...
  end function h
  subroutine test
    type(t),allocatable :: b(:)
    allocate(b(2),source=h(2.5))
  end subroutine test7
end module type
```

`DoFromSourceAssign` creates two descriptors for initializing
`b(1)` and `b(2)` from the result of `h`. This Create call
creates a descriptor without properly initialized addendum,
so the Assign just does shallow copies of the descriptor
representing result of `h` into `b(1)` and `b(2)`.

I modified Create code to properly establish the descriptor
for derived type case.

I had to keep the `addendum` argument to keep the testing
in `flang/unittests/Runtime/TemporaryStack.cpp`.


>From d1573b796996aef6087f8dec2d6527dd42ce1b7d Mon Sep 17 00:00:00 2001
From: Slava Zakharin <szakharin at nvidia.com>
Date: Wed, 27 Sep 2023 16:56:25 -0700
Subject: [PATCH] [flang][runtime] Establish derived type desc properly.

Example:
```
module types
  type t
     real,allocatable :: c
  end type t
contains
  function h(x)
    class(t),allocatable :: h
    ...
  end function h
  subroutine test
    type(t),allocatable :: b(:)
    allocate(b(2),source=h(2.5))
  end subroutine test7
end module type
```

`DoFromSourceAssign` creates two descriptors for initializing
`b(1)` and `b(2)` from the result of `h`. This Create call
creates a descriptor without properly initialized addendum,
so the Assign just does shallow copies of the descriptor
representing result of `h` into `b(1)` and `b(2)`.

I modified Create code to properly establish the descriptor
for derived type case.

I had to keep the `addendum` argument to keep the testing
in `flang/unittests/Runtime/TemporaryStack.cpp`.
---
 flang/include/flang/Runtime/descriptor.h |  8 ++++++--
 flang/runtime/descriptor.cpp             | 15 +++++++++++----
 2 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h
index 62a8d123bf2ee06..2aa881c535c1f32 100644
--- a/flang/include/flang/Runtime/descriptor.h
+++ b/flang/include/flang/Runtime/descriptor.h
@@ -180,12 +180,16 @@ class Descriptor {
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
-  // CUDA_TODO: Clang does not support unique_ptr on device.
+  // To create a descriptor for a derived type the caller
+  // must provide non-null dt argument.
+  // The addendum argument is only used for testing purposes,
+  // and it may force a descriptor with an addendum while
+  // dt may be null.
   static OwningPtr<Descriptor> Create(TypeCode t, std::size_t elementBytes,
       void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
-      int derivedTypeLenParameters = 0);
+      bool addendum = false, const typeInfo::DerivedType *dt = nullptr);
   static OwningPtr<Descriptor> Create(TypeCategory, int kind, void *p = nullptr,
       int rank = maxRank, const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
diff --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp
index ab6460708e9b68f..95bba82a3a2963d 100644
--- a/flang/runtime/descriptor.cpp
+++ b/flang/runtime/descriptor.cpp
@@ -96,12 +96,19 @@ void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
 
 OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
     void *p, int rank, const SubscriptValue *extent,
-    ISO::CFI_attribute_t attribute, int derivedTypeLenParameters) {
-  std::size_t bytes{SizeInBytes(rank, true, derivedTypeLenParameters)};
+    ISO::CFI_attribute_t attribute, bool addendum,
+    const typeInfo::DerivedType *dt) {
   Terminator terminator{__FILE__, __LINE__};
+  RUNTIME_CHECK(terminator, t.IsDerived() == (dt != nullptr));
+  int derivedTypeLenParameters = dt ? dt->LenParameters() : 0;
+  std::size_t bytes{SizeInBytes(rank, addendum, derivedTypeLenParameters)};
   Descriptor *result{
       reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
-  result->Establish(t, elementBytes, p, rank, extent, attribute, true);
+  if (dt) {
+    result->Establish(*dt, p, rank, extent, attribute);
+  } else {
+    result->Establish(t, elementBytes, p, rank, extent, attribute, addendum);
+  }
   return OwningPtr<Descriptor>{result};
 }
 
@@ -122,7 +129,7 @@ OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
     void *p, int rank, const SubscriptValue *extent,
     ISO::CFI_attribute_t attribute) {
   return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
-      extent, attribute, dt.LenParameters());
+      extent, attribute, /*addendum=*/true, &dt);
 }
 
 std::size_t Descriptor::SizeInBytes() const {