Skip to content

Commit efd5cde

Browse files
authored
[flang][runtime] Finalize polymorphic components using dynamic type (llvm#67040)
Previous code was finalizing polymorphic components according to static type (calling the static type final routine, if any). There is no way (I think) to know from a Fortran::runtime::typeInfo::Component if an allocatable component is polymorphic or not. So this patch just always uses the dynamic type descriptor to check for derived type allocatable component finalization.
1 parent 469b3bf commit efd5cde

File tree

1 file changed

+19
-1
lines changed

1 file changed

+19
-1
lines changed

flang/runtime/derived.cpp

Lines changed: 19 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -209,7 +209,25 @@ void Finalize(const Descriptor &descriptor,
209209
k < myComponents; ++k) {
210210
const auto &comp{
211211
*componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
212-
if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
212+
if (comp.genre() == typeInfo::Component::Genre::Allocatable &&
213+
comp.category() == TypeCategory::Derived) {
214+
// Component may be polymorphic or unlimited polymorphic. Need to use the
215+
// dynamic type to check whether finalization is needed.
216+
for (std::size_t j{0}; j < elements; ++j) {
217+
const Descriptor &compDesc{*descriptor.OffsetElement<Descriptor>(
218+
j * byteStride + comp.offset())};
219+
if (compDesc.IsAllocated()) {
220+
if (const DescriptorAddendum * addendum{compDesc.Addendum()}) {
221+
if (const typeInfo::DerivedType *
222+
compDynamicType{addendum->derivedType()}) {
223+
if (!compDynamicType->noFinalizationNeeded()) {
224+
Finalize(compDesc, *compDynamicType, terminator);
225+
}
226+
}
227+
}
228+
}
229+
}
230+
} else if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
213231
comp.genre() == typeInfo::Component::Genre::Automatic) {
214232
if (const typeInfo::DerivedType * compType{comp.derivedType()}) {
215233
if (!compType->noFinalizationNeeded()) {

0 commit comments

Comments
 (0)