Skip to content

Commit b71bbbb

Browse files
clementvalclementval
committed
[flang] Only deallocate intent(out) allocatable through runtime if allocated
Deallocation of intent(out) allocatable was done in D133348. This patch adds an if guard when the deallocation is done through a runtime call. The runtime is crashing if the box is not allocated. Call the runtime only if the box is allocated. This is the case for derived type, polymorphic and unlimited polymorphic entities. Reviewed By: PeteSteinfeld Differential Revision: https://reviews.llvm.org/D141427
1 parent d9630c3 commit b71bbbb

File tree

3 files changed

+74
-7
lines changed

3 files changed

+74
-7
lines changed

‎flang/lib/Lower/ConvertExpr.cpp

Lines changed: 14 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2598,8 +2598,20 @@ class ScalarExprLowering {
25982598
if (arg.mayBeModifiedByCall())
25992599
mutableModifiedByCall.emplace_back(std::move(mutableBox));
26002600
if (fir::isAllocatableType(argTy) && arg.isIntentOut() &&
2601-
Fortran::semantics::IsBindCProcedure(*procRef.proc().GetSymbol()))
2602-
Fortran::lower::genDeallocateBox(converter, mutableBox, loc);
2601+
Fortran::semantics::IsBindCProcedure(*procRef.proc().GetSymbol())) {
2602+
if (mutableBox.isDerived() || mutableBox.isPolymorphic() ||
2603+
mutableBox.isUnlimitedPolymorphic()) {
2604+
mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
2605+
builder, loc, mutableBox);
2606+
builder.genIfThen(loc, isAlloc)
2607+
.genThen([&]() {
2608+
Fortran::lower::genDeallocateBox(converter, mutableBox, loc);
2609+
})
2610+
.end();
2611+
} else {
2612+
Fortran::lower::genDeallocateBox(converter, mutableBox, loc);
2613+
}
2614+
}
26032615
continue;
26042616
}
26052617
if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar ||

‎flang/lib/Lower/ConvertVariable.cpp

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -649,15 +649,24 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
649649
if (mlir::isa<fir::AllocaOp>(op))
650650
return;
651651
mlir::Location loc = converter.getCurrentLocation();
652+
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
652653
if (Fortran::semantics::IsOptional(sym)) {
653-
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
654654
auto isPresent = builder.create<fir::IsPresentOp>(
655655
loc, builder.getI1Type(), fir::getBase(extVal));
656656
builder.genIfThen(loc, isPresent)
657657
.genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
658658
.end();
659659
} else {
660-
genDeallocateBox(converter, *mutBox, loc);
660+
if (mutBox->isDerived() || mutBox->isPolymorphic() ||
661+
mutBox->isUnlimitedPolymorphic()) {
662+
mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
663+
builder, loc, *mutBox);
664+
builder.genIfThen(loc, isAlloc)
665+
.genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
666+
.end();
667+
} else {
668+
genDeallocateBox(converter, *mutBox, loc);
669+
}
661670
}
662671
}
663672
}

‎flang/test/Lower/intentout-deallocate.f90

Lines changed: 49 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,19 @@
11
! Test correct deallocation of intent(out) allocatables.
2-
! RUN: bbc -emit-fir %s -o - | FileCheck %s
2+
! RUN: bbc -emit-fir -polymorphic-type %s -o - | FileCheck %s
33

44
module mod1
55
type, bind(c) :: t1
66
integer :: i
77
end type
88

9+
type :: t
10+
integer :: a
11+
end type
12+
13+
type, extends(t) :: t2
14+
integer :: b
15+
end type
16+
917
interface
1018
subroutine sub3(a) bind(c)
1119
integer, intent(out), allocatable :: a(:)
@@ -91,8 +99,14 @@ subroutine sub5(t)
9199

92100
! CHECK-LABEL: func.func @_QMmod1Psub5(
93101
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>> {fir.bindc_name = "t"})
94-
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
95-
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
102+
! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>
103+
! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>) -> !fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>
104+
! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>) -> i64
105+
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
106+
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
107+
! CHECK: fir.if %[[IS_ALLOCATED]] {
108+
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
109+
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
96110

97111
subroutine sub6()
98112
type(t1), allocatable :: t
@@ -189,5 +203,37 @@ subroutine sub12(a)
189203
! CHECK: fir.store %[[EMBOX]] to %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
190204

191205

206+
subroutine sub14(p)
207+
class(t), intent(out), allocatable :: p
208+
end subroutine
209+
210+
! CHECK-LABEL: func.func @_QMmod1Psub14(
211+
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>> {fir.bindc_name = "p"}) {
212+
! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>
213+
! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>) -> !fir.heap<!fir.type<_QMmod1Tt{a:i32}>>
214+
! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>) -> i64
215+
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
216+
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
217+
! CHECK: fir.if %[[IS_ALLOCATED]] {
218+
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>) -> !fir.ref<!fir.box<none>>
219+
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
220+
! CHECK: }
221+
222+
subroutine sub15(p)
223+
class(*), intent(out), allocatable :: p
224+
end subroutine
225+
226+
! CHECK-LABEL: func.func @_QMmod1Psub15(
227+
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "p"}) {
228+
! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<none>>>
229+
! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.class<!fir.heap<none>>) -> !fir.heap<none>
230+
! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<none>) -> i64
231+
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
232+
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
233+
! CHECK: fir.if %[[IS_ALLOCATED]] {
234+
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
235+
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
236+
! CHECK: }
237+
192238
end module
193239

0 commit comments

Comments
 (0)