[flang-commits] [flang] [flang][runtime] Destroy nested allocatable components (PR #81117)
via flang-commits
flang-commits at lists.llvm.org
Thu Feb 8 02:15:59 PST 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-runtime
Author: None (jeanPerier)
<details>
<summary>Changes</summary>
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.
---
Full diff: https://github.com/llvm/llvm-project/pull/81117.diff
2 Files Affected:
- (modified) flang/runtime/assign.cpp (+4)
- (modified) flang/runtime/derived.cpp (+40-19)
``````````diff
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);
+ }
}
}
}
``````````
</details>
https://github.com/llvm/llvm-project/pull/81117
More information about the flang-commits
mailing list