shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity

[flang] Only deallocate intent(out) allocatable through runtime if allocated

Browse Source 
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
This commit is contained in:
Valentin Clement 2023-01-11 09:20:28 +01:00
parent d9630c34f4
commit b71bbbb64f
No known key found for this signature in database
GPG Key ID: 086D54783C928776
3 changed files with 74 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
flang/lib/Lower/ConvertExpr.cpp
View File

@ -2598,8 +2598,20 @@ public:
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 ||

13
flang/lib/Lower/ConvertVariable.cpp
View File

@ -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);
}
}
}
}

52
flang/test/Lower/intentout-deallocate.f90
View File

@ -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(:)
@ -91,8 +99,14 @@ contains
! 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
@ -189,5 +203,37 @@ contains
! 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