[flang-commits] [flang] 5f6e0f3 - [flang][runtime] Destroy nested allocatable components (#81117)
via flang-commits
flang-commits at lists.llvm.org
Thu Feb 15 00:04:46 PST 2024
Author: jeanPerier
Date: 2024-02-15T09:04:42+01:00
New Revision: 5f6e0f35f936495563b5758a7ff9d4417a9f651b
URL: https://github.com/llvm/llvm-project/commit/5f6e0f35f936495563b5758a7ff9d4417a9f651b
DIFF: https://github.com/llvm/llvm-project/commit/5f6e0f35f936495563b5758a7ff9d4417a9f651b.diff
LOG: [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.
Added:
Modified:
flang/runtime/assign.cpp
flang/runtime/derived.cpp
Removed:
################################################################################
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
index 879b413efe1270..25d2ba4501c115 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 8a0d0ab2bb7836..67eb901c1a3d9a 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);
+ }
}
}
}
More information about the flang-commits
mailing list