[flang] Deep copy nested allocatable components in transformational (#81736)

Spread, reshape, pack, and other transformational intrinsic runtimes are
using `CopyElement` utility to copy elements. This utility was dealing
with deep copies, but only when the allocatable components where
"immediate" components of the type being copied. If the allocatable
components were nested inside a nonpointer/nonallocatable component,
they were not deep copied, leading to bugs later when manipulating the
value (or double free when applying #81117).

Visit data components with allocatable components (using the
noDestructionNeeded flag to avoid expensive and useless type visit when
there are no such components).

Author: jeanPerier

flang/runtime/copy.cpp

@@ -20,11 +20,13 @@ RT_API_ATTRS void CopyElement(const Descriptor &to, const SubscriptValue toAt[],
     const Descriptor &from, const SubscriptValue fromAt[],
     Terminator &terminator) {
   char *toPtr{to.Element<char>(toAt)};
-  const char *fromPtr{from.Element<const char>(fromAt)};
+  char *fromPtr{from.Element<char>(fromAt)};
   RUNTIME_CHECK(terminator, to.ElementBytes() == from.ElementBytes());
   std::memcpy(toPtr, fromPtr, to.ElementBytes());
+  // Deep copy allocatable and automatic components if any.
   if (const auto *addendum{to.Addendum()}) {
-    if (const auto *derived{addendum->derivedType()}) {
+    if (const auto *derived{addendum->derivedType()};
+        derived && !derived->noDestructionNeeded()) {
       RUNTIME_CHECK(terminator,
           from.Addendum() && derived == from.Addendum()->derivedType());
       const Descriptor &componentDesc{derived->component()};
@@ -43,6 +45,26 @@ RT_API_ATTRS void CopyElement(const Descriptor &to, const SubscriptValue toAt[],
                 fromPtr + component->offset())};
             CopyArray(toDesc, fromDesc, terminator);
           }
+        } else if (component->genre() == typeInfo::Component::Genre::Data &&
+            component->derivedType() &&
+            !component->derivedType()->noDestructionNeeded()) {
+          SubscriptValue extents[maxRank];
+          const typeInfo::Value *bounds{component->bounds()};
+          for (int dim{0}; dim < component->rank(); ++dim) {
+            SubscriptValue lb{bounds[2 * dim].GetValue(&to).value_or(0)};
+            SubscriptValue ub{bounds[2 * dim + 1].GetValue(&to).value_or(0)};
+            extents[dim] = ub >= lb ? ub - lb + 1 : 0;
+          }
+          const typeInfo::DerivedType &compType{*component->derivedType()};
+          StaticDescriptor<maxRank, true, 0> toStaticDescriptor;
+          Descriptor &toCompDesc{toStaticDescriptor.descriptor()};
+          toCompDesc.Establish(compType, toPtr + component->offset(),
+              component->rank(), extents);
+          StaticDescriptor<maxRank, true, 0> fromStaticDescriptor;
+          Descriptor &fromCompDesc{fromStaticDescriptor.descriptor()};
+          fromCompDesc.Establish(compType, fromPtr + component->offset(),
+              component->rank(), extents);
+          CopyArray(toCompDesc, fromCompDesc, terminator);
         }
       }
     }

flang/runtime/derived.cpp

@@ -340,16 +340,9 @@ RT_API_ATTRS void Destroy(const Descriptor &descriptor, bool finalize,
 RT_API_ATTRS bool HasDynamicComponent(const Descriptor &descriptor) {
   if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
     if (const auto *derived = addendum->derivedType()) {
-      const Descriptor &componentDesc{derived->component()};
-      std::size_t myComponents{componentDesc.Elements()};
-      for (std::size_t k{0}; k < myComponents; ++k) {
-        const auto &comp{
-            *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
-        if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
-            comp.genre() == typeInfo::Component::Genre::Automatic) {
-          return true;
-        }
-      }
+      // Destruction is needed if and only if there are direct or indirect
+      // allocatable or automatic components.
+      return !derived->noDestructionNeeded();
     }
   }
   return false;