Skip to content

Commit 35f5c8d

Browse files
vzakharivzakhari
authored
[flang][hlfir] Fixed missing deallocation for components of function … (llvm#67768)
…result. If function result have allocatable components or components that may require finalization, we have to call Destroy runtime for them. We also have to free the top-level entity's memory regardless of whether we called Destroy or not.
1 parent 81ea91a commit 35f5c8d

File tree

2 files changed

+226
-18
lines changed

2 files changed

+226
-18
lines changed

‎flang/lib/Lower/ConvertCall.cpp

Lines changed: 29 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -428,14 +428,36 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
428428
}
429429

430430
if (allocatedResult) {
431+
// The result must be optionally destroyed (if it is of a derived type
432+
// that may need finalization or deallocation of the components).
433+
// For an allocatable result we have to free the memory allocated
434+
// for the top-level entity. Note that the Destroy calls below
435+
// do not deallocate the top-level entity. The two clean-ups
436+
// must be pushed in reverse order, so that the final order is:
437+
// Destroy(desc)
438+
// free(desc->base_addr)
439+
allocatedResult->match(
440+
[&](const fir::MutableBoxValue &box) {
441+
if (box.isAllocatable()) {
442+
// 9.7.3.2 point 4. Deallocate allocatable results. Note that
443+
// finalization was done independently by calling
444+
// genDerivedTypeDestroy above and is not triggered by this inline
445+
// deallocation.
446+
fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
447+
stmtCtx.attachCleanup([bldr, loc, box]() {
448+
fir::factory::genFreememIfAllocated(*bldr, loc, box);
449+
});
450+
}
451+
},
452+
[](const auto &) {});
453+
431454
// 7.5.6.3 point 5. Derived-type finalization for nonpointer function.
432455
// Check if the derived-type is finalizable if it is a monomorphic
433456
// derived-type.
434457
// For polymorphic and unlimited polymorphic enities call the runtime
435458
// in any cases.
436459
std::optional<Fortran::evaluate::DynamicType> retTy =
437460
caller.getCallDescription().proc().GetType();
438-
bool cleanupWithDestroy = false;
439461
// With HLFIR lowering, isElemental must be set to true
440462
// if we are producing an elemental call. In this case,
441463
// the elemental results must not be destroyed, instead,
@@ -451,34 +473,23 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
451473
fir::runtime::genDerivedTypeDestroy(*bldr, loc,
452474
fir::getBase(*allocatedResult));
453475
});
454-
cleanupWithDestroy = true;
455476
} else {
456477
const Fortran::semantics::DerivedTypeSpec &typeSpec =
457478
retTy->GetDerivedTypeSpec();
458-
if (Fortran::semantics::IsFinalizable(typeSpec)) {
479+
// If the result type may require finalization
480+
// or have allocatable components, we need to make sure
481+
// everything is properly finalized/deallocated.
482+
if (Fortran::semantics::MayRequireFinalization(typeSpec) ||
483+
// We can use DerivedTypeDestroy even if finalization is not needed.
484+
hlfir::mayHaveAllocatableComponent(funcType.getResults()[0])) {
459485
auto *bldr = &converter.getFirOpBuilder();
460486
stmtCtx.attachCleanup([bldr, loc, allocatedResult]() {
461487
mlir::Value box = bldr->createBox(loc, *allocatedResult);
462488
fir::runtime::genDerivedTypeDestroy(*bldr, loc, box);
463489
});
464-
cleanupWithDestroy = true;
465490
}
466491
}
467492
}
468-
allocatedResult->match(
469-
[&](const fir::MutableBoxValue &box) {
470-
if (box.isAllocatable() && !cleanupWithDestroy) {
471-
// 9.7.3.2 point 4. Deallocate allocatable results. Note that
472-
// finalization was done independently by calling
473-
// genDerivedTypeDestroy above and is not triggered by this inline
474-
// deallocation.
475-
fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
476-
stmtCtx.attachCleanup([bldr, loc, box]() {
477-
fir::factory::genFreememIfAllocated(*bldr, loc, box);
478-
});
479-
}
480-
},
481-
[](const auto &) {});
482493
return *allocatedResult;
483494
}
484495

‎flang/test/Lower/HLFIR/function-return-destroy.f90

Lines changed: 197 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,197 @@
1+
! RUN: bbc -emit-hlfir -polymorphic-type %s -o - -I nowhere | FileCheck %s
2+
3+
module types
4+
type t1
5+
real :: x
6+
end type t1
7+
type t2
8+
real, allocatable :: x
9+
end type t2
10+
type t3
11+
real, pointer :: p
12+
end type t3
13+
type t4
14+
type(t1) :: c
15+
end type t4
16+
type t5
17+
type(t2) :: c
18+
end type t5
19+
type t6
20+
contains
21+
final :: finalize_t6
22+
end type t6
23+
type, extends(t1) :: t7
24+
end type t7
25+
type, extends(t2) :: t8
26+
end type t8
27+
type, extends(t6) :: t9
28+
end type t9
29+
contains
30+
subroutine finalize_t6(x)
31+
type(t6), intent(inout) :: x
32+
end subroutine finalize_t6
33+
end module types
34+
35+
subroutine test1
36+
use types
37+
interface
38+
function ret_type_t1
39+
use types
40+
type(t1) :: ret_type_t1
41+
end function ret_type_t1
42+
end interface
43+
type(t1) :: x
44+
x = ret_type_t1()
45+
end subroutine test1
46+
! CHECK-LABEL: func.func @_QPtest1() {
47+
! CHECK-NOT: fir.call{{.*}}Destroy
48+
49+
subroutine test1a
50+
use types
51+
interface
52+
function ret_type_t1a
53+
use types
54+
type(t1), allocatable :: ret_type_t1a
55+
end function ret_type_t1a
56+
end interface
57+
type(t1), allocatable :: x
58+
x = ret_type_t1a()
59+
end subroutine test1a
60+
! CHECK-LABEL: func.func @_QPtest1a() {
61+
! CHECK-NOT: fir.call{{.*}}Destroy
62+
! CHECK: fir.if %{{.*}} {
63+
! CHECK-NEXT: fir.freemem %{{.*}} : !fir.heap<!fir.type<_QMtypesTt1{x:f32}>>
64+
! CHECK-NOT: fir.call{{.*}}Destroy
65+
! CHECK: fir.if %{{.*}} {
66+
! CHECK: fir.call @_FortranAAllocatableDeallocate({{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
67+
! CHECK-NOT: fir.call{{.*}}Destroy
68+
69+
subroutine test1c
70+
use types
71+
interface
72+
function ret_class_t1
73+
use types
74+
class(t1), allocatable :: ret_class_t1
75+
end function ret_class_t1
76+
end interface
77+
type(t1) :: x
78+
x = ret_class_t1()
79+
end subroutine test1c
80+
! CHECK-LABEL: func.func @_QPtest1c() {
81+
! CHECK: fir.call @_FortranADestroy
82+
! CHECK: fir.if %{{.*}} {
83+
! CHECK-NEXT: fir.freemem %{{.*}} : !fir.heap<!fir.type<_QMtypesTt1{x:f32}>>
84+
85+
subroutine test2
86+
use types
87+
interface
88+
function ret_type_t2
89+
use types
90+
type(t2) :: ret_type_t2
91+
end function ret_type_t2
92+
end interface
93+
type(t2) :: x
94+
x = ret_type_t2()
95+
end subroutine test2
96+
! CHECK-LABEL: func.func @_QPtest2() {
97+
! CHECK: fir.call @_FortranADestroy
98+
99+
subroutine test3
100+
use types
101+
interface
102+
function ret_type_t3
103+
use types
104+
type(t3) :: ret_type_t3
105+
end function ret_type_t3
106+
end interface
107+
type(t3) :: x
108+
x = ret_type_t3()
109+
end subroutine test3
110+
! CHECK-LABEL: func.func @_QPtest3() {
111+
! CHECK-NOT: fir.call{{.*}}Destroy
112+
113+
subroutine test4
114+
use types
115+
interface
116+
function ret_type_t4
117+
use types
118+
type(t4) :: ret_type_t4
119+
end function ret_type_t4
120+
end interface
121+
type(t4) :: x
122+
x = ret_type_t4()
123+
end subroutine test4
124+
! CHECK-LABEL: func.func @_QPtest4() {
125+
! CHECK-NOT: fir.call{{.*}}Destroy
126+
127+
subroutine test5
128+
use types
129+
interface
130+
function ret_type_t5
131+
use types
132+
type(t5) :: ret_type_t5
133+
end function ret_type_t5
134+
end interface
135+
type(t5) :: x
136+
x = ret_type_t5()
137+
end subroutine test5
138+
! CHECK-LABEL: func.func @_QPtest5() {
139+
! CHECK: fir.call @_FortranADestroy
140+
141+
subroutine test6
142+
use types
143+
interface
144+
function ret_type_t6
145+
use types
146+
type(t6) :: ret_type_t6
147+
end function ret_type_t6
148+
end interface
149+
type(t6) :: x
150+
x = ret_type_t6()
151+
end subroutine test6
152+
! CHECK-LABEL: func.func @_QPtest6() {
153+
! CHECK: fir.call @_FortranADestroy
154+
! CHECK: fir.call @_FortranADestroy
155+
156+
subroutine test7
157+
use types
158+
interface
159+
function ret_type_t7
160+
use types
161+
type(t7) :: ret_type_t7
162+
end function ret_type_t7
163+
end interface
164+
type(t7) :: x
165+
x = ret_type_t7()
166+
end subroutine test7
167+
! CHECK-LABEL: func.func @_QPtest7() {
168+
! CHECK-NOT: fir.call{{.*}}Destroy
169+
170+
subroutine test8
171+
use types
172+
interface
173+
function ret_type_t8
174+
use types
175+
type(t8) :: ret_type_t8
176+
end function ret_type_t8
177+
end interface
178+
type(t8) :: x
179+
x = ret_type_t8()
180+
end subroutine test8
181+
! CHECK-LABEL: func.func @_QPtest8() {
182+
! CHECK: fir.call @_FortranADestroy
183+
184+
subroutine test9
185+
use types
186+
interface
187+
function ret_type_t9
188+
use types
189+
type(t9) :: ret_type_t9
190+
end function ret_type_t9
191+
end interface
192+
type(t9) :: x
193+
x = ret_type_t9()
194+
end subroutine test9
195+
! CHECK-LABEL: func.func @_QPtest9() {
196+
! CHECK: fir.call @_FortranADestroy
197+
! CHECK: fir.call @_FortranADestroy

0 commit comments

Comments
 (0)