[flang] Finalize polymorphic alloctable component if needed (#67326)

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.

Author: jeanPerier

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>()}) {

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)))});

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);

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)