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

[via flang-commits]

Author: Slava Zakharin
Date: 2023-09-28T14:05:55-07:00
New Revision: 2b2d79fbdf4a69061136ded875ec18b057ba7b2f

URL: https://github.com/llvm/llvm-project/commit/2b2d79fbdf4a69061136ded875ec18b057ba7b2f
DIFF: https://github.com/llvm/llvm-project/commit/2b2d79fbdf4a69061136ded875ec18b057ba7b2f.diff

LOG: [flang][runtime] Establish derived type desc properly. (#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`.

Added: 
    

Modified: 
    flang/include/flang/Runtime/descriptor.h
    flang/runtime/descriptor.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h
index 34f497ecf261588..d26139321227fc2 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 RT_API_ATTRS 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 RT_API_ATTRS OwningPtr<Descriptor> Create(TypeCategory, int kind,
       void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,

diff  --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp
index b36e4e409f04169..8dd3f215279baed 100644
--- a/flang/runtime/descriptor.cpp
+++ b/flang/runtime/descriptor.cpp
@@ -99,12 +99,19 @@ RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt,
 
 RT_API_ATTRS 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};
 }
 
@@ -126,7 +133,7 @@ RT_API_ATTRS 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);
 }
 
 RT_API_ATTRS std::size_t Descriptor::SizeInBytes() const {