[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:30 PST 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/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.
>From 869f92a6b4d1d8f2b75b3d5e6c375c75652525b3 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 8 Feb 2024 02:00:32 -0800
Subject: [PATCH] [flang][runtime] Destroy nested allocatable components
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.
---
flang/runtime/assign.cpp | 4 +++
flang/runtime/derived.cpp | 59 ++++++++++++++++++++++++++-------------
2 files changed, 44 insertions(+), 19 deletions(-)
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
index 879b413efe127..25d2ba4501c11 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 8a0d0ab2bb783..67eb901c1a3d9 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