[flang][runtime] Destroy nested allocatable components (#81117)

The runtime was currently only deallocating the direct allocatable
components, which caused leaks when there are allocatable components
nested in the direct components.

Update Destroy to recursively destroy components.

Also call Destroy from Assign to deallocate nested allocatable
components before doing the assignment as required by F2018 9.7.3.2
point 7.

This lack of deallocation was visible if the nested components had user
defined assignment "observing" the allocation state.

2 files changed, 44 insertions, 19 deletions

diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
index 879b413..25d2ba4 100644
--- a/flang/runtime/assign.cpp
+++ b/flang/runtime/assign.cpp
@@ -320,6 +320,8 @@ RT_API_ATTRS static void Assign(
         if ((flags & NeedFinalization) && toDerived) {
           Finalize(to, *toDerived, &terminator);
           flags &= ~NeedFinalization;
+        } else if (toDerived && !toDerived->noDestructionNeeded()) {
+          Destroy(to, /*finalize=*/false, *toDerived, &terminator);
         }
       } else {
         to.Destroy((flags & NeedFinalization) != 0, /*destroyPointers=*/false,
@@ -389,6 +391,8 @@ RT_API_ATTRS static void Assign(
     // The target is first finalized if still necessary (7.5.6.3(1))
     if (flags & NeedFinalization) {
       Finalize(to, *updatedToDerived, &terminator);
+    } else if (updatedToDerived && !updatedToDerived->noDestructionNeeded()) {
+      Destroy(to, /*finalize=*/false, *updatedToDerived, &terminator);
     }
     // Copy the data components (incl. the parent) first.
     const Descriptor &componentDesc{updatedToDerived->component()};
diff --git a/flang/runtime/derived.cpp b/flang/runtime/derived.cpp
index 8a0d0ab..67eb901 100644
--- a/flang/runtime/derived.cpp
+++ b/flang/runtime/derived.cpp
@@ -17,6 +17,19 @@ namespace Fortran::runtime {
 
 RT_OFFLOAD_API_GROUP_BEGIN
 
+// Fill "extents" array with the extents of component "comp" from derived type
+// instance "derivedInstance".
+static RT_API_ATTRS void GetComponentExtents(SubscriptValue (&extents)[maxRank],
+    const typeInfo::Component &comp, const Descriptor &derivedInstance) {
+  const typeInfo::Value *bounds{comp.bounds()};
+  for (int dim{0}; dim < comp.rank(); ++dim) {
+    SubscriptValue lb{bounds[2 * dim].GetValue(&derivedInstance).value_or(0)};
+    SubscriptValue ub{
+        bounds[2 * dim + 1].GetValue(&derivedInstance).value_or(0)};
+    extents[dim] = ub >= lb ? ub - lb + 1 : 0;
+  }
+}
+
 RT_API_ATTRS int Initialize(const Descriptor &instance,
     const typeInfo::DerivedType &derived, Terminator &terminator, bool hasStat,
     const Descriptor *errMsg) {
@@ -77,22 +90,15 @@ RT_API_ATTRS int Initialize(const Descriptor &instance,
         comp.derivedType() && !comp.derivedType()->noInitializationNeeded()) {
       // Default initialization of non-pointer non-allocatable/automatic
       // data component.  Handles parent component's elements.  Recursive.
-      SubscriptValue extent[maxRank];
-      const typeInfo::Value *bounds{comp.bounds()};
-      for (int dim{0}; dim < comp.rank(); ++dim) {
-        typeInfo::TypeParameterValue lb{
-            bounds[2 * dim].GetValue(&instance).value_or(0)};
-        typeInfo::TypeParameterValue ub{
-            bounds[2 * dim + 1].GetValue(&instance).value_or(0)};
-        extent[dim] = ub >= lb ? ub - lb + 1 : 0;
-      }
+      SubscriptValue extents[maxRank];
+      GetComponentExtents(extents, comp, instance);
       StaticDescriptor<maxRank, true, 0> staticDescriptor;
       Descriptor &compDesc{staticDescriptor.descriptor()};
       const typeInfo::DerivedType &compType{*comp.derivedType()};
       for (std::size_t j{0}; j++ < elements; instance.IncrementSubscripts(at)) {
         compDesc.Establish(compType,
             instance.ElementComponent<char>(at, comp.offset()), comp.rank(),
-            extent);
+            extents);
         stat = Initialize(compDesc, compType, terminator, hasStat, errMsg);
         if (stat != StatOk) {
           break;
@@ -253,14 +259,8 @@ RT_API_ATTRS void Finalize(const Descriptor &descriptor,
       }
     } else if (comp.genre() == typeInfo::Component::Genre::Data &&
         comp.derivedType() && !comp.derivedType()->noFinalizationNeeded()) {
-      SubscriptValue extent[maxRank];
-      const typeInfo::Value *bounds{comp.bounds()};
-      for (int dim{0}; dim < comp.rank(); ++dim) {
-        SubscriptValue lb{bounds[2 * dim].GetValue(&descriptor).value_or(0)};
-        SubscriptValue ub{
-            bounds[2 * dim + 1].GetValue(&descriptor).value_or(0)};
-        extent[dim] = ub >= lb ? ub - lb + 1 : 0;
-      }
+      SubscriptValue extents[maxRank];
+      GetComponentExtents(extents, comp, descriptor);
       StaticDescriptor<maxRank, true, 0> staticDescriptor;
       Descriptor &compDesc{staticDescriptor.descriptor()};
       const typeInfo::DerivedType &compType{*comp.derivedType()};
@@ -268,7 +268,7 @@ RT_API_ATTRS void Finalize(const Descriptor &descriptor,
            descriptor.IncrementSubscripts(at)) {
         compDesc.Establish(compType,
             descriptor.ElementComponent<char>(at, comp.offset()), comp.rank(),
-            extent);
+            extents);
         Finalize(compDesc, compType, terminator);
       }
     }
@@ -296,6 +296,8 @@ RT_API_ATTRS void Destroy(const Descriptor &descriptor, bool finalize,
   if (finalize && !derived.noFinalizationNeeded()) {
     Finalize(descriptor, derived, terminator);
   }
+  // Deallocate all direct and indirect allocatable and automatic components.
+  // Contrary to finalization, the order of deallocation does not matter.
   const Descriptor &componentDesc{derived.component()};
   std::size_t myComponents{componentDesc.Elements()};
   std::size_t elements{descriptor.Elements()};
@@ -304,14 +306,33 @@ RT_API_ATTRS void Destroy(const Descriptor &descriptor, bool finalize,
   for (std::size_t k{0}; k < myComponents; ++k) {
     const auto &comp{
         *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
+    const bool destroyComp{
+        comp.derivedType() && !comp.derivedType()->noDestructionNeeded()};
     if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
         comp.genre() == typeInfo::Component::Genre::Automatic) {
       for (std::size_t j{0}; j < elements; ++j) {
         Descriptor *d{
             descriptor.ElementComponent<Descriptor>(at, comp.offset())};
+        if (destroyComp) {
+          Destroy(*d, /*finalize=*/false, *comp.derivedType(), terminator);
+        }
         d->Deallocate();
         descriptor.IncrementSubscripts(at);
       }
+    } else if (destroyComp &&
+        comp.genre() == typeInfo::Component::Genre::Data) {
+      SubscriptValue extents[maxRank];
+      GetComponentExtents(extents, comp, descriptor);
+      StaticDescriptor<maxRank, true, 0> staticDescriptor;
+      Descriptor &compDesc{staticDescriptor.descriptor()};
+      const typeInfo::DerivedType &compType{*comp.derivedType()};
+      for (std::size_t j{0}; j++ < elements;
+           descriptor.IncrementSubscripts(at)) {
+        compDesc.Establish(compType,
+            descriptor.ElementComponent<char>(at, comp.offset()), comp.rank(),
+            extents);
+        Destroy(compDesc, /*finalize=*/false, *comp.derivedType(), terminator);
+      }
     }
   }
 }