Skip to content

Commit

Permalink
[flang] Only deallocate intent(out) allocatable through runtime if al…
Browse files Browse the repository at this point in the history 
…located

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
  • Loading branch information
@clementval
clementval committed Jan 11, 2023
1 parent d9630c3 commit b71bbbb
Show file tree
Hide file tree
Showing 3 changed files with 74 additions and 7 deletions.
16 changes: 14 additions & 2 deletions flang/lib/Lower/ConvertExpr.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2598,8 +2598,20 @@ class ScalarExprLowering {
if (arg.mayBeModifiedByCall())
mutableModifiedByCall.emplace_back(std::move(mutableBox));
if (fir::isAllocatableType(argTy) && arg.isIntentOut() &&
Fortran::semantics::IsBindCProcedure(*procRef.proc().GetSymbol()))
Fortran::lower::genDeallocateBox(converter, mutableBox, loc);
Fortran::semantics::IsBindCProcedure(*procRef.proc().GetSymbol())) {
if (mutableBox.isDerived() || mutableBox.isPolymorphic() ||
mutableBox.isUnlimitedPolymorphic()) {
mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
builder, loc, mutableBox);
builder.genIfThen(loc, isAlloc)
.genThen([&]() {
Fortran::lower::genDeallocateBox(converter, mutableBox, loc);
})
.end();
} else {
Fortran::lower::genDeallocateBox(converter, mutableBox, loc);
}
}
continue;
}
if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar ||
Expand Down
13 changes: 11 additions & 2 deletions flang/lib/Lower/ConvertVariable.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -649,15 +649,24 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
if (mlir::isa<fir::AllocaOp>(op))
return;
mlir::Location loc = converter.getCurrentLocation();
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
if (Fortran::semantics::IsOptional(sym)) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
auto isPresent = builder.create<fir::IsPresentOp>(
loc, builder.getI1Type(), fir::getBase(extVal));
builder.genIfThen(loc, isPresent)
.genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
.end();
} else {
genDeallocateBox(converter, *mutBox, loc);
if (mutBox->isDerived() || mutBox->isPolymorphic() ||
mutBox->isUnlimitedPolymorphic()) {
mlir::Value isAlloc = fir::factory::genIsAllocatedOrAssociatedTest(
builder, loc, *mutBox);
builder.genIfThen(loc, isAlloc)
.genThen([&]() { genDeallocateBox(converter, *mutBox, loc); })
.end();
} else {
genDeallocateBox(converter, *mutBox, loc);
}
}
}
}
Expand Down
52 changes: 49 additions & 3 deletions flang/test/Lower/intentout-deallocate.f90
View file
Original file line number Diff line number Diff line change
@@ -1,11 +1,19 @@
! Test correct deallocation of intent(out) allocatables.
! RUN: bbc -emit-fir %s -o - | FileCheck %s
! RUN: bbc -emit-fir -polymorphic-type %s -o - | FileCheck %s

module mod1
type, bind(c) :: t1
integer :: i
end type

type :: t
integer :: a
end type

type, extends(t) :: t2
integer :: b
end type

interface
subroutine sub3(a) bind(c)
integer, intent(out), allocatable :: a(:)
Expand Down Expand Up @@ -91,8 +99,14 @@ subroutine sub5(t)

! CHECK-LABEL: func.func @_QMmod1Psub5(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>> {fir.bindc_name = "t"})
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>
! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>) -> !fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>
! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>) -> i64
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
! CHECK: fir.if %[[IS_ALLOCATED]] {
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32

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


subroutine sub14(p)
class(t), intent(out), allocatable :: p
end subroutine

! CHECK-LABEL: func.func @_QMmod1Psub14(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>> {fir.bindc_name = "p"}) {
! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>
! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>) -> !fir.heap<!fir.type<_QMmod1Tt{a:i32}>>
! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>) -> i64
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
! CHECK: fir.if %[[IS_ALLOCATED]] {
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMmod1Tt{a:i32}>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: }

subroutine sub15(p)
class(*), intent(out), allocatable :: p
end subroutine

! CHECK-LABEL: func.func @_QMmod1Psub15(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "p"}) {
! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<none>>>
! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.class<!fir.heap<none>>) -> !fir.heap<none>
! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap<none>) -> i64
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
! CHECK: %[[IS_ALLOCATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_PTR]], %[[C0]] : i64
! CHECK: fir.if %[[IS_ALLOCATED]] {
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: }

end module

0 comments on commit b71bbbb

Please sign in to comment.