[flang-commits] [PATCH] D155965: [flang] Finalize &/or destroy ABSTRACT types

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: vzakhari.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D155965

Files:
  flang/lib/Semantics/runtime-type-info.cpp
  flang/test/Semantics/typeinfo04.f90


Index: flang/test/Semantics/typeinfo04.f90
===================================================================
--- /dev/null
+++ 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
Index: flang/lib/Semantics/runtime-type-info.cpp
===================================================================
--- flang/lib/Semantics/runtime-type-info.cpp
+++ flang/lib/Semantics/runtime-type-info.cpp
@@ -572,8 +572,7 @@
                     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 @@
             !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)))});


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D155965.542933.patch
Type: text/x-patch
Size: 3753 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230721/da27ec19/attachment-0001.bin>