Skip to content

Commit 0c7d0ad

Browse files
jeanPerierjeanPerier
authored
[flang] Deallocate local allocatable at end of their scopes (#67036)
Implement automatic deallocation of unsaved local alloctables when reaching the end of their scope of block as described in Fortran 2018 9.7.3.2 point 2. and 3. Uses genDeallocateIfAllocated used for intent(out) deallocation and the "function context" already used for finalization at end of scope.
1 parent 22f423a commit 0c7d0ad

File tree

3 files changed

+276
-20
lines changed

3 files changed

+276
-20
lines changed

‎flang/lib/Lower/ConvertVariable.cpp

+35-16
Original file line numberDiff line numberDiff line change
@@ -652,26 +652,30 @@ defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter,
652652
}
653653
}
654654

655-
/// Check whether a variable needs to be finalized according to clause 7.5.6.3
656-
/// point 3.
657-
/// Must be nonpointer, nonallocatable object that is not a dummy argument or
658-
/// function result.
659-
static bool needEndFinalization(const Fortran::lower::pft::Variable &var) {
655+
enum class VariableCleanUp { Finalize, Deallocate };
656+
/// Check whether a local variable needs to be finalized according to clause
657+
/// 7.5.6.3 point 3 or if it is an allocatable that must be deallocated. Note
658+
/// that deallocation will trigger finalization if the type has any.
659+
static std::optional<VariableCleanUp>
660+
needDeallocationOrFinalization(const Fortran::lower::pft::Variable &var) {
660661
if (!var.hasSymbol())
661-
return false;
662+
return std::nullopt;
662663
const Fortran::semantics::Symbol &sym = var.getSymbol();
663664
const Fortran::semantics::Scope &owner = sym.owner();
664665
if (owner.kind() == Fortran::semantics::Scope::Kind::MainProgram) {
665666
// The standard does not require finalizing main program variables.
666-
return false;
667+
return std::nullopt;
667668
}
668669
if (!Fortran::semantics::IsPointer(sym) &&
669-
!Fortran::semantics::IsAllocatable(sym) &&
670670
!Fortran::semantics::IsDummy(sym) &&
671671
!Fortran::semantics::IsFunctionResult(sym) &&
672-
!Fortran::semantics::IsSaved(sym))
673-
return hasFinalization(sym);
674-
return false;
672+
!Fortran::semantics::IsSaved(sym)) {
673+
if (Fortran::semantics::IsAllocatable(sym))
674+
return VariableCleanUp::Deallocate;
675+
if (hasFinalization(sym))
676+
return VariableCleanUp::Finalize;
677+
}
678+
return std::nullopt;
675679
}
676680

677681
/// Check whether a variable needs the be finalized according to clause 7.5.6.3
@@ -779,15 +783,30 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
779783
finalizeAtRuntime(converter, var, symMap);
780784
if (mustBeDefaultInitializedAtRuntime(var))
781785
defaultInitializeAtRuntime(converter, var, symMap);
782-
if (needEndFinalization(var)) {
786+
if (std::optional<VariableCleanUp> cleanup =
787+
needDeallocationOrFinalization(var)) {
783788
auto *builder = &converter.getFirOpBuilder();
784789
mlir::Location loc = converter.getCurrentLocation();
785790
fir::ExtendedValue exv =
786791
converter.getSymbolExtendedValue(var.getSymbol(), &symMap);
787-
converter.getFctCtx().attachCleanup([builder, loc, exv]() {
788-
mlir::Value box = builder->createBox(loc, exv);
789-
fir::runtime::genDerivedTypeDestroy(*builder, loc, box);
790-
});
792+
switch (*cleanup) {
793+
case VariableCleanUp::Finalize:
794+
converter.getFctCtx().attachCleanup([builder, loc, exv]() {
795+
mlir::Value box = builder->createBox(loc, exv);
796+
fir::runtime::genDerivedTypeDestroy(*builder, loc, box);
797+
});
798+
break;
799+
case VariableCleanUp::Deallocate:
800+
auto *converterPtr = &converter;
801+
converter.getFctCtx().attachCleanup([converterPtr, loc, exv]() {
802+
const fir::MutableBoxValue *mutableBox =
803+
exv.getBoxOf<fir::MutableBoxValue>();
804+
assert(mutableBox &&
805+
"trying to deallocate entity not lowered as allocatable");
806+
Fortran::lower::genDeallocateIfAllocated(*converterPtr, *mutableBox,
807+
loc);
808+
});
809+
}
791810
}
792811
}
793812

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

+239
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,239 @@
1+
! Test automatic deallocation of local allocatables as described in
2+
! Fortran 2018 standard 9.7.3.2 point 2. and 3.
3+
4+
! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
5+
module dtypedef
6+
type must_finalize
7+
integer :: i
8+
contains
9+
final :: finalize
10+
end type
11+
type contain_must_finalize
12+
type(must_finalize) :: a
13+
end type
14+
interface
15+
subroutine finalize(a)
16+
import :: must_finalize
17+
type(must_finalize), intent(inout) :: a
18+
end subroutine
19+
end interface
20+
real, allocatable :: x
21+
end module
22+
23+
subroutine simple()
24+
real, allocatable :: x
25+
allocate(x)
26+
call bar()
27+
end subroutine
28+
! CHECK-LABEL: func.func @_QPsimple() {
29+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}"_QFsimpleEx"
30+
! CHECK: fir.call @_QPbar
31+
! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>>
32+
! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
33+
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<f32>) -> i64
34+
! CHECK: %[[VAL_9:.*]] = arith.constant 0 : i64
35+
! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_8]], %[[VAL_9]] : i64
36+
! CHECK: fir.if %[[VAL_10]] {
37+
! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>>
38+
! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
39+
! CHECK: fir.freemem %[[VAL_12]] : !fir.heap<f32>
40+
! CHECK: %[[VAL_13:.*]] = fir.zero_bits !fir.heap<f32>
41+
! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] : (!fir.heap<f32>) -> !fir.box<!fir.heap<f32>>
42+
! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>>
43+
! CHECK: }
44+
45+
subroutine multiple_return(cdt)
46+
real, allocatable :: x
47+
logical :: cdt
48+
allocate(x)
49+
if (cdt) return
50+
call bar()
51+
end subroutine
52+
! CHECK-LABEL: func.func @_QPmultiple_return(
53+
! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2
54+
! CHECK: ^bb1:
55+
! CHECK-NOT: fir.freemem
56+
! CHECK: cf.br ^bb3
57+
! CHECK: ^bb2:
58+
! CHECK: fir.call @_QPbar
59+
! CHECK: cf.br ^bb3
60+
! CHECK: ^bb3:
61+
! CHECK: fir.if {{.*}} {
62+
! CHECK: fir.freemem
63+
! CHECK: }
64+
! CHECK: return
65+
66+
subroutine derived()
67+
use dtypedef, only : must_finalize
68+
type(must_finalize), allocatable :: x
69+
allocate(x)
70+
call bar()
71+
end subroutine
72+
! CHECK-LABEL: func.func @_QPderived() {
73+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}"_QFderivedEx"
74+
! CHECK: fir.call @_QPbar
75+
! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>>
76+
! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>) -> !fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>
77+
! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>) -> i64
78+
! CHECK: %[[VAL_14:.*]] = arith.constant 0 : i64
79+
! CHECK: %[[VAL_15:.*]] = arith.cmpi ne, %[[VAL_13]], %[[VAL_14]] : i64
80+
! CHECK: fir.if %[[VAL_15]] {
81+
! CHECK: %[[VAL_16:.*]] = arith.constant false
82+
! CHECK: %[[VAL_17:.*]] = fir.absent !fir.box<none>
83+
! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
84+
! CHECK: %[[VAL_22:.*]] = fir.call @_FortranAAllocatableDeallocate(%[[VAL_20]], %[[VAL_16]], %[[VAL_17]], %{{.*}}, %{{.*}})
85+
! CHECK: }
86+
87+
subroutine derived2()
88+
use dtypedef, only : contain_must_finalize
89+
type(contain_must_finalize), allocatable :: x
90+
allocate(x)
91+
end subroutine
92+
! CHECK-LABEL: func.func @_QPderived2(
93+
! CHECK: fir.if {{.*}} {
94+
! CHECK: fir.call @_FortranAAllocatableDeallocate
95+
! CHECK: }
96+
97+
subroutine simple_block()
98+
block
99+
real, allocatable :: x
100+
allocate(x)
101+
call bar()
102+
end block
103+
call bar_after_block()
104+
end subroutine
105+
! CHECK-LABEL: func.func @_QPsimple_block(
106+
! CHECK: fir.call @_QPbar
107+
! CHECK: fir.if {{.*}} {
108+
! CHECK: fir.freemem
109+
! CHECK: }
110+
! CHECK: fir.call @_QPbar_after_block
111+
112+
subroutine mutiple_return_block(cdt)
113+
logical :: cdt
114+
block
115+
real, allocatable :: x
116+
allocate(x)
117+
if (cdt) return
118+
call bar()
119+
end block
120+
call bar_after_block()
121+
end subroutine
122+
! CHECK-LABEL: func.func @_QPmutiple_return_block(
123+
! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2
124+
! CHECK: ^bb1:
125+
! CHECK: fir.if {{.*}} {
126+
! CHECK: fir.freemem
127+
! CHECK: }
128+
! CHECK: cf.br ^bb3
129+
! CHECK: ^bb2:
130+
! CHECK: fir.call @_QPbar
131+
! CHECK: fir.if {{.*}} {
132+
! CHECK: fir.freemem
133+
! CHECK: }
134+
! CHECK: fir.call @_QPbar_after_block
135+
! CHECK: cf.br ^bb3
136+
! CHECK: ^bb3:
137+
! CHECK: return
138+
139+
140+
subroutine derived_block()
141+
use dtypedef, only : must_finalize
142+
block
143+
type(must_finalize), allocatable :: x
144+
allocate(x)
145+
call bar()
146+
end block
147+
call bar_after_block()
148+
end subroutine
149+
! CHECK-LABEL: func.func @_QPderived_block(
150+
! CHECK: fir.call @_QPbar
151+
! CHECK: fir.if {{.*}} {
152+
! CHECK: fir.call @_FortranAAllocatableDeallocate
153+
! CHECK: }
154+
! CHECK: fir.call @_QPbar_after_block
155+
156+
subroutine derived_block2()
157+
use dtypedef, only : contain_must_finalize
158+
call bar()
159+
block
160+
type(contain_must_finalize), allocatable :: x
161+
allocate(x)
162+
end block
163+
call bar_after_block()
164+
end subroutine
165+
! CHECK-LABEL: func.func @_QPderived_block2(
166+
! CHECK: fir.call @_QPbar
167+
! CHECK: fir.if {{.*}} {
168+
! CHECK: fir.call @_FortranAAllocatableDeallocate
169+
! CHECK: }
170+
! CHECK: fir.call @_QPbar_after_block
171+
172+
subroutine no_dealloc_saved()
173+
real, allocatable, save :: x
174+
allocate(x)
175+
end subroutine
176+
! CHECK-LABEL: func.func @_QPno_dealloc_save
177+
! CHECK-NOT: freemem
178+
! CHECK-NOT: Deallocate
179+
! CHECK: return
180+
181+
subroutine no_dealloc_block_saved()
182+
block
183+
real, allocatable, save :: x
184+
allocate(x)
185+
end block
186+
end subroutine
187+
! CHECK-LABEL: func.func @_QPno_dealloc_block_saved
188+
! CHECK-NOT: freemem
189+
! CHECK-NOT: Deallocate
190+
! CHECK: return
191+
192+
function no_dealloc_result() result(x)
193+
real, allocatable :: x
194+
allocate(x)
195+
end function
196+
! CHECK-LABEL: func.func @_QPno_dealloc_result
197+
! CHECK-NOT: freemem
198+
! CHECK-NOT: Deallocate
199+
! CHECK: return
200+
201+
subroutine no_dealloc_dummy(x)
202+
real, allocatable :: x
203+
allocate(x)
204+
end subroutine
205+
! CHECK-LABEL: func.func @_QPno_dealloc_dummy
206+
! CHECK-NOT: freemem
207+
! CHECK-NOT: Deallocate
208+
! CHECK: return
209+
210+
subroutine no_dealloc_module_var()
211+
use dtypedef, only : x
212+
allocate(x)
213+
end subroutine
214+
! CHECK-LABEL: func.func @_QPno_dealloc_module_var
215+
! CHECK-NOT: freemem
216+
! CHECK-NOT: Deallocate
217+
! CHECK: return
218+
219+
subroutine no_dealloc_host_assoc()
220+
real, allocatable :: x
221+
call internal()
222+
contains
223+
subroutine internal()
224+
allocate(x)
225+
end subroutine
226+
end subroutine
227+
! CHECK-LABEL: func.func @_QFno_dealloc_host_assocPinternal
228+
! CHECK-NOT: freemem
229+
! CHECK-NOT: Deallocate
230+
! CHECK: return
231+
232+
subroutine no_dealloc_pointer(x)
233+
real, pointer :: x
234+
allocate(x)
235+
end subroutine
236+
! CHECK-LABEL: func.func @_QPno_dealloc_pointer
237+
! CHECK-NOT: freemem
238+
! CHECK-NOT: Deallocate
239+
! CHECK: return

‎flang/test/Lower/allocatable-polymorphic.f90

+2-4
Original file line numberDiff line numberDiff line change
@@ -656,11 +656,9 @@ program test_alloc
656656
! allocatable.
657657

658658
! LLVM-LABEL: define void @_QMpolyPtest_deallocate()
659-
! LLVM: %[[ALLOCA1:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }
660-
! LLVM: %[[ALLOCA2:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, i64 1
661-
! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } { ptr null, i64 ptrtoint (ptr getelementptr (%_QMpolyTp1, ptr null, i32 1) to i64), i32 20180515, i8 0, i8 42, i8 2, i8 1, ptr @_QMpolyE.dt.p1, [1 x i64] undef }, ptr %[[ALLOCA1]]
659+
! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } { ptr null, i64 ptrtoint (ptr getelementptr (%_QMpolyTp1, ptr null, i32 1) to i64), i32 20180515, i8 0, i8 42, i8 2, i8 1, ptr @_QMpolyE.dt.p1, [1 x i64] undef }, ptr %[[ALLOCA1:[0-9]*]]
662660
! LLVM: %[[LOAD:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[ALLOCA1]]
663-
! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOAD]], ptr %[[ALLOCA2]]
661+
! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOAD]], ptr %[[ALLOCA2:[0-9]*]]
664662
! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerivedForAllocate(ptr %[[ALLOCA2]], ptr @_QMpolyE.dt.p1, i32 0, i32 0)
665663
! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr %[[ALLOCA2]], i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
666664
! LLVM: %{{.*}} = call i32 @_FortranAAllocatableDeallocatePolymorphic(ptr %[[ALLOCA2]], ptr {{.*}}, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})

0 commit comments

Comments
 (0)