Skip to content

Commit be66a2f

Browse files
vzakharivzakhari
authored
[flang] Deallocate components of local variables at the end of the scope. (llvm#68064)
Call Destroy runtime for local variables of derived types with allocatable components.
1 parent cfe8ae3 commit be66a2f

File tree

4 files changed

+138
-0
lines changed

4 files changed

+138
-0
lines changed

‎flang/include/flang/Semantics/tools.h‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -180,6 +180,8 @@ const Symbol *HasImpureFinal(const Symbol &);
180180
// Is this type finalizable or does it contain any polymorphic allocatable
181181
// ultimate components?
182182
bool MayRequireFinalization(const DerivedTypeSpec &derived);
183+
// Does this type have an allocatable direct component?
184+
bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived);
183185

184186
bool IsInBlankCommon(const Symbol &);
185187
inline bool IsAssumedSizeArray(const Symbol &symbol) {

‎flang/lib/Lower/ConvertVariable.cpp‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -96,6 +96,17 @@ static bool hasFinalization(const Fortran::semantics::Symbol &sym) {
9696
return false;
9797
}
9898

99+
// Does this variable have an allocatable direct component?
100+
static bool
101+
hasAllocatableDirectComponent(const Fortran::semantics::Symbol &sym) {
102+
if (sym.has<Fortran::semantics::ObjectEntityDetails>())
103+
if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
104+
if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
105+
declTypeSpec->AsDerived())
106+
return Fortran::semantics::HasAllocatableDirectComponent(
107+
*derivedTypeSpec);
108+
return false;
109+
}
99110
//===----------------------------------------------------------------===//
100111
// Global variables instantiation (not for alias and common)
101112
//===----------------------------------------------------------------===//
@@ -670,6 +681,15 @@ needDeallocationOrFinalization(const Fortran::lower::pft::Variable &var) {
670681
return VariableCleanUp::Deallocate;
671682
if (hasFinalization(sym))
672683
return VariableCleanUp::Finalize;
684+
// hasFinalization() check above handled all cases that require
685+
// finalization, but we also have to deallocate all allocatable
686+
// components of local variables (since they are also local variables
687+
// according to F18 5.4.3.2.2, p. 2, note 1).
688+
// Here, the variable itself is not allocatable. If it has an allocatable
689+
// component the Destroy runtime does the job. Use the Finalize clean-up,
690+
// though there will be no finalization in runtime.
691+
if (hasAllocatableDirectComponent(sym))
692+
return VariableCleanUp::Finalize;
673693
}
674694
return std::nullopt;
675695
}

‎flang/lib/Semantics/tools.cpp‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -841,6 +841,11 @@ bool MayRequireFinalization(const DerivedTypeSpec &derived) {
841841
FindPolymorphicAllocatableUltimateComponent(derived);
842842
}
843843

844+
bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived) {
845+
DirectComponentIterator directs{derived};
846+
return std::any_of(directs.begin(), directs.end(), IsAllocatable);
847+
}
848+
844849
bool IsAssumedLengthCharacter(const Symbol &symbol) {
845850
if (const DeclTypeSpec * type{symbol.GetType()}) {
846851
return type->category() == DeclTypeSpec::Character &&

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

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
! Test automatic deallocation of allocatable components
2+
! of local variables as described in Fortran 2018 standard
3+
! 9.7.3.2 point 2. and 3.
4+
! The allocatable components of local variables are local variables
5+
! themselves due to 5.4.3.2.2 p. 2, note 1.
6+
! RUN: bbc -emit-hlfir -o - -I nowhere %s | FileCheck %s
7+
8+
module types
9+
type t1
10+
real, allocatable :: x
11+
end type t1
12+
type t2
13+
type(t1) :: x
14+
end type t2
15+
type, extends(t1) :: t3
16+
end type t3
17+
type, extends(t3) :: t4
18+
end type t4
19+
type, extends(t2) :: t5
20+
end type t5
21+
end module types
22+
23+
subroutine test1()
24+
use types
25+
type(t1) :: x1
26+
end subroutine test1
27+
! CHECK-LABEL: func.func @_QPtest1() {
28+
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
29+
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
30+
31+
subroutine test1b()
32+
use types
33+
block
34+
type(t1) :: x1
35+
end block
36+
end subroutine test1b
37+
! CHECK-LABEL: func.func @_QPtest1b() {
38+
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
39+
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
40+
41+
subroutine test2()
42+
use types
43+
type(t2) :: x2
44+
end subroutine test2
45+
! CHECK-LABEL: func.func @_QPtest2() {
46+
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
47+
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt2{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>
48+
49+
subroutine test2b()
50+
use types
51+
block
52+
type(t2) :: x2
53+
end block
54+
end subroutine test2b
55+
! CHECK-LABEL: func.func @_QPtest2b() {
56+
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
57+
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt2{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>
58+
59+
subroutine test3()
60+
use types
61+
type(t3) :: x3
62+
end subroutine test3
63+
! CHECK-LABEL: func.func @_QPtest3() {
64+
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
65+
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt3{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
66+
67+
subroutine test3b()
68+
use types
69+
block
70+
type(t3) :: x3
71+
end block
72+
end subroutine test3b
73+
! CHECK-LABEL: func.func @_QPtest3b() {
74+
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
75+
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt3{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
76+
77+
subroutine test4()
78+
use types
79+
type(t4) :: x4
80+
end subroutine test4
81+
! CHECK-LABEL: func.func @_QPtest4() {
82+
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
83+
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt4{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
84+
85+
subroutine test4b()
86+
use types
87+
block
88+
type(t4) :: x4
89+
end block
90+
end subroutine test4b
91+
! CHECK-LABEL: func.func @_QPtest4b() {
92+
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
93+
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt4{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>
94+
95+
subroutine test5()
96+
use types
97+
type(t5) :: x5
98+
end subroutine test5
99+
! CHECK-LABEL: func.func @_QPtest5() {
100+
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
101+
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt5{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>
102+
103+
subroutine test5b()
104+
use types
105+
block
106+
type(t5) :: x5
107+
end block
108+
end subroutine test5b
109+
! CHECK-LABEL: func.func @_QPtest5b() {
110+
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
111+
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt5{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>

0 commit comments

Comments
 (0)