[flang-commits] [flang] 01c38ab - [flang] Finalize &/or destroy ABSTRACT types

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-07-21T12:26:35-07:00
New Revision: 01c38ab7a2ead5894d91e7f56634ffad9a9a94a4

URL: https://github.com/llvm/llvm-project/commit/01c38ab7a2ead5894d91e7f56634ffad9a9a94a4
DIFF: https://github.com/llvm/llvm-project/commit/01c38ab7a2ead5894d91e7f56634ffad9a9a94a4.diff

LOG: [flang] Finalize &/or destroy ABSTRACT types

The runtime type information tables always flag ABSTRACT types as
needing neither destruction in general nor finalization in particular.
This is incorrect.  Although an ABSTRACT type may not itself have
a FINAL procedure -- its argument cannot be polymorphic, but
ABSTRACT types in declarations must always be so -- it can still
have finalizable components &/or components requiring deallocation.

Differential Revision: https://reviews.llvm.org/D155965

Added: 
    flang/test/Semantics/typeinfo04.f90

Modified: 
    flang/lib/Semantics/runtime-type-info.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index a6b8d646e6eae3..cfce8c2e57d7b5 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -572,8 +572,7 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
                     procPtrComponents.size())}));
     // Compile the "vtable" of type-bound procedure bindings
     std::uint32_t specialBitSet{0};
-    bool isAbstractType{dtSymbol->attrs().test(Attr::ABSTRACT)};
-    if (!isAbstractType) {
+    if (!dtSymbol->attrs().test(Attr::ABSTRACT)) {
       std::vector<evaluate::StructureConstructor> bindings{
           DescribeBindings(dtScope, scope)};
       AddValue(dtValues, derivedTypeSchema_, bindingDescCompName,
@@ -630,12 +629,10 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
             !derivedTypeSpec->HasDefaultInitialization(false, false)));
     // Similarly, a flag to short-circuit destruction when not needed.
     AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
-        IntExpr<1>(isAbstractType ||
-            (derivedTypeSpec && !derivedTypeSpec->HasDestruction())));
+        IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
     // Similarly, a flag to short-circuit finalization when not needed.
     AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s,
-        IntExpr<1>(isAbstractType ||
-            (derivedTypeSpec && !IsFinalizable(*derivedTypeSpec))));
+        IntExpr<1>(derivedTypeSpec && !IsFinalizable(*derivedTypeSpec)));
   }
   dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
       StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});

diff  --git a/flang/test/Semantics/typeinfo04.f90 b/flang/test/Semantics/typeinfo04.f90
new file mode 100644
index 00000000000000..de8464321a409e
--- /dev/null
+++ b/flang/test/Semantics/typeinfo04.f90
@@ -0,0 +1,26 @@
+!RUN: bbc --dump-symbols %s | FileCheck %s
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+! Ensure ABSTRACT types are properly marked for finalization &/or
+! destruction.
+module m
+  type :: finalizable
+   contains
+    final :: final
+  end type
+!CHECK: .dt.finalizable, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.finalizable,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.finalizable,specialbitset=128_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+  type, abstract :: t1
+  end type
+!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t1,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+  type, abstract :: t2
+    real, allocatable :: a(:)
+  end type
+!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t2,sizeinbytes=48_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1)
+  type, abstract :: t3
+    type(finalizable) :: x
+  end type
+!CHECK: .dt.t3, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t3,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t3,procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+ contains
+  impure elemental subroutine final(x)
+    type(finalizable), intent(in out) :: x
+  end
+end