[flang] Deallocate components of local variables at the end of the sc…

…ope. (llvm#68064)

Call Destroy runtime for local variables of derived types with
allocatable components.

flang/include/flang/Semantics/tools.h

@@ -180,6 +180,8 @@ const Symbol *HasImpureFinal(const Symbol &);
 // Is this type finalizable or does it contain any polymorphic allocatable
 // ultimate components?
 bool MayRequireFinalization(const DerivedTypeSpec &derived);
+// Does this type have an allocatable direct component?
+bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived);
 
 bool IsInBlankCommon(const Symbol &);
 inline bool IsAssumedSizeArray(const Symbol &symbol) {

flang/lib/Lower/ConvertVariable.cpp

@@ -96,6 +96,17 @@ static bool hasFinalization(const Fortran::semantics::Symbol &sym) {
   return false;
 }
 
+// Does this variable have an allocatable direct component?
+static bool
+hasAllocatableDirectComponent(const Fortran::semantics::Symbol &sym) {
+  if (sym.has<Fortran::semantics::ObjectEntityDetails>())
+    if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
+      if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
+              declTypeSpec->AsDerived())
+        return Fortran::semantics::HasAllocatableDirectComponent(
+            *derivedTypeSpec);
+  return false;
+}
 //===----------------------------------------------------------------===//
 // Global variables instantiation (not for alias and common)
 //===----------------------------------------------------------------===//
@@ -670,6 +681,15 @@ needDeallocationOrFinalization(const Fortran::lower::pft::Variable &var) {
       return VariableCleanUp::Deallocate;
     if (hasFinalization(sym))
       return VariableCleanUp::Finalize;
+    // hasFinalization() check above handled all cases that require
+    // finalization, but we also have to deallocate all allocatable
+    // components of local variables (since they are also local variables
+    // according to F18 5.4.3.2.2, p. 2, note 1).
+    // Here, the variable itself is not allocatable. If it has an allocatable
+    // component the Destroy runtime does the job. Use the Finalize clean-up,
+    // though there will be no finalization in runtime.
+    if (hasAllocatableDirectComponent(sym))
+      return VariableCleanUp::Finalize;
   }
   return std::nullopt;
 }

flang/lib/Semantics/tools.cpp

@@ -841,6 +841,11 @@ bool MayRequireFinalization(const DerivedTypeSpec &derived) {
       FindPolymorphicAllocatableUltimateComponent(derived);
 }
 
+bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived) {
+  DirectComponentIterator directs{derived};
+  return std::any_of(directs.begin(), directs.end(), IsAllocatable);
+}
+
 bool IsAssumedLengthCharacter(const Symbol &symbol) {
   if (const DeclTypeSpec * type{symbol.GetType()}) {
     return type->category() == DeclTypeSpec::Character &&

flang/test/Lower/HLFIR/local-end-of-scope-component-dealloc.f90

@@ -0,0 +1,111 @@
+! Test automatic deallocation of allocatable components
+! of local variables as described in Fortran 2018 standard
+! 9.7.3.2 point 2. and 3.
+! The allocatable components of local variables are local variables
+! themselves due to 5.4.3.2.2 p. 2, note 1.
+! RUN: bbc -emit-hlfir -o - -I nowhere %s | FileCheck %s
+
+module types
+  type t1
+     real, allocatable :: x
+  end type t1
+  type t2
+     type(t1) :: x
+  end type t2
+  type, extends(t1) :: t3
+  end type t3
+  type, extends(t3) :: t4
+  end type t4
+  type, extends(t2) :: t5
+  end type t5
+end module types
+
+subroutine test1()
+  use types
+  type(t1) :: x1
+end subroutine test1
+! CHECK-LABEL:   func.func @_QPtest1() {
+! CHECK-DAG:       %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
+
+subroutine test1b()
+  use types
+  block
+    type(t1) :: x1
+  end block
+end subroutine test1b
+! CHECK-LABEL:   func.func @_QPtest1b() {
+! CHECK-DAG:       %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
+
+subroutine test2()
+  use types
+  type(t2) :: x2
+end subroutine test2
+! CHECK-LABEL:   func.func @_QPtest2() {
+! CHECK-DAG:       %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt2{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>
+
+subroutine test2b()
+  use types
+  block
+    type(t2) :: x2
+  end block
+end subroutine test2b
+! CHECK-LABEL:   func.func @_QPtest2b() {
+! CHECK-DAG:       %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt2{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>
+
+subroutine test3()
+  use types
+  type(t3) :: x3
+end subroutine test3
+! CHECK-LABEL:   func.func @_QPtest3() {
+! CHECK-DAG:       %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt3{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
+
+subroutine test3b()
+  use types
+  block
+    type(t3) :: x3
+  end block
+end subroutine test3b
+! CHECK-LABEL:   func.func @_QPtest3b() {
+! CHECK-DAG:       %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt3{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
+
+subroutine test4()
+  use types
+  type(t4) :: x4
+end subroutine test4
+! CHECK-LABEL:   func.func @_QPtest4() {
+! CHECK-DAG:       %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt4{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
+
+subroutine test4b()
+  use types
+  block
+    type(t4) :: x4
+  end block
+end subroutine test4b
+! CHECK-LABEL:   func.func @_QPtest4b() {
+! CHECK-DAG:       %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt4{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
+
+subroutine test5()
+  use types
+  type(t5) :: x5
+end subroutine test5
+! CHECK-LABEL:   func.func @_QPtest5() {
+! CHECK-DAG:       %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt5{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>
+
+subroutine test5b()
+  use types
+  block
+    type(t5) :: x5
+  end block
+end subroutine test5b
+! CHECK-LABEL:   func.func @_QPtest5b() {
+! CHECK-DAG:       %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
+! CHECK-DAG:       %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt5{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>