[flang] Finalize polymorphic alloctable component if needed

[jeanPerier]

The runtime skips finalization if the runtime type info "nofinalizationneeded" is set, so it should not be set if the derived type has polymorphic allocatable components since they may be allocated to some type extension with a final methods.
IsFinalizable cannot be updated since polymorphic allocatable components do not imply a final routine will actually be called (it depends of the dynamic type, which semantics cannot know about), and this would not match the "Finalizable" definition of the standard in 7.5.6.1. Hence, this patch adds a MayRequireFinalization helper.

The component visitor change is to avoid crashing in FindPolymorphicAllocatableUltimateComponent in the test test/Driver/dump-all-bad.f90 that tries generating runtime type info even after some semantic error is raised under debug-dump options.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-runtime

Changes

The runtime skips finalization if the runtime type info "nofinalizationneeded" is set, so it should not be set if the derived type has polymorphic allocatable components since they may be allocated to some type extension with a final methods.
IsFinalizable cannot be updated since polymorphic allocatable components do not imply a final routine will actually be called (it depends of the dynamic type, which semantics cannot know about), and this would not match the "Finalizable" definition of the standard in 7.5.6.1. Hence, this patch adds a MayRequireFinalization helper.

The component visitor change is to avoid crashing in FindPolymorphicAllocatableUltimateComponent in the test test/Driver/dump-all-bad.f90 that tries generating runtime type info even after some semantic error is raised under debug-dump options.

---

Full diff: https://github.com/llvm/llvm-project/pull/67326.diff

4 Files Affected:

• (modified) flang/include/flang/Semantics/tools.h (+4)
• (modified) flang/lib/Semantics/runtime-type-info.cpp (+2-1)
• (modified) flang/lib/Semantics/tools.cpp (+7-1)
• (added) flang/test/Semantics/typeinfo07.f90 (+22)

diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 12649da6adbe21a..ab48ef422801a44 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -177,6 +177,10 @@ const Symbol *IsFinalizable(const DerivedTypeSpec &,
     std::set<const DerivedTypeSpec *> * = nullptr,
     bool withImpureFinalizer = false, std::optional<int> rank = std::nullopt);
 const Symbol *HasImpureFinal(const Symbol &);
+// Is this type finalizable or does it contain any polymorphic allocatable
+// ultimate components?
+bool MayRequireFinalization(const DerivedTypeSpec &derived);
+
 bool IsInBlankCommon(const Symbol &);
 inline bool IsAssumedSizeArray(const Symbol &symbol) {
   if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index aa470ecdc771941..8ccb98663f885ab 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -642,7 +642,8 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
         IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
     // Similarly, a flag to short-circuit finalization when not needed.
     AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s,
-        IntExpr<1>(derivedTypeSpec && !IsFinalizable(*derivedTypeSpec)));
+        IntExpr<1>(
+            derivedTypeSpec && !MayRequireFinalization(*derivedTypeSpec)));
   }
   dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
       StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 54047f9c8d0a37b..25ffcb68eaf87a2 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -836,6 +836,11 @@ const Symbol *HasImpureFinal(const Symbol &original) {
   return nullptr;
 }
 
+bool MayRequireFinalization(const DerivedTypeSpec &derived) {
+  return IsFinalizable(derived) ||
+      FindPolymorphicAllocatableUltimateComponent(derived);
+}
+
 bool IsAssumedLengthCharacter(const Symbol &symbol) {
   if (const DeclTypeSpec * type{symbol.GetType()}) {
     return type->category() == DeclTypeSpec::Character &&
@@ -1249,7 +1254,8 @@ static bool StopAtComponentPre(const Symbol &component) {
   } else if constexpr (componentKind == ComponentKind::Ultimate) {
     return component.has<ProcEntityDetails>() ||
         IsAllocatableOrObjectPointer(&component) ||
-        (component.get<ObjectEntityDetails>().type() &&
+        (component.has<ObjectEntityDetails>() &&
+            component.get<ObjectEntityDetails>().type() &&
             component.get<ObjectEntityDetails>().type()->AsIntrinsic());
   } else if constexpr (componentKind == ComponentKind::Potential) {
     return !IsPointer(component);
diff --git a/flang/test/Semantics/typeinfo07.f90 b/flang/test/Semantics/typeinfo07.f90
new file mode 100644
index 000000000000000..e8766d9811db8fb
--- /dev/null
+++ b/flang/test/Semantics/typeinfo07.f90
@@ -0,0 +1,22 @@
+! Test "nofinalizationneeded" is set to false for derived type
+! containing polymorphic allocatable ultimate components.
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+
+  type :: t_base
+  end type
+  type :: t_container_not_polymorphic
+     type(t_base), allocatable :: comp
+  end type
+  type :: t_container
+     class(t_base), allocatable :: comp
+  end type
+  type, extends(t_container) :: t_container_extension
+  end type
+  type :: t_container_wrapper
+    type(t_container_extension) :: wrapper
+  end type
+end
+! CHECK: .dt.t_container, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+! CHECK: .dt.t_container_extension, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+! CHECK: .dt.t_container_not_polymorphic, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1)
+! CHECK: .dt.t_container_wrapper, SAVE, TARGET (CompilerCreated, ReadOnly): {{.*}}noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)