From b71bbbb64ff92184e13a793b71982df4cdee0271 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Wed, 11 Jan 2023 09:20:28 +0100 Subject: [PATCH] [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 --- flang/lib/Lower/ConvertExpr.cpp | 16 ++++++++-- flang/lib/Lower/ConvertVariable.cpp | 13 ++++++-- flang/test/Lower/intentout-deallocate.f90 | 52 +++++++++++++++++++++++++++++-- 3 files changed, 74 insertions(+), 7 deletions(-) diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 74147db..fc698e0 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -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 || diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index 374380c..017a842 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -649,15 +649,24 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter, if (mlir::isa(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( 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); + } } } } diff --git a/flang/test/Lower/intentout-deallocate.f90 b/flang/test/Lower/intentout-deallocate.f90 index eef3e6c..c0a5e1c 100644 --- a/flang/test/Lower/intentout-deallocate.f90 +++ b/flang/test/Lower/intentout-deallocate.f90 @@ -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.bindc_name = "t"}) -! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref>>>) -> !fir.ref> -! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref>>> +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap>) -> 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.ref> +! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 subroutine sub6() type(t1), allocatable :: t @@ -189,5 +203,37 @@ contains ! CHECK: fir.store %[[EMBOX]] to %[[ARG0]] : !fir.ref>>> + subroutine sub14(p) + class(t), intent(out), allocatable :: p + end subroutine + +! CHECK-LABEL: func.func @_QMmod1Psub14( +! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>>> {fir.bindc_name = "p"}) { +! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref>>> +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.class>>) -> !fir.heap> +! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap>) -> 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.ref> +! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: } + + subroutine sub15(p) + class(*), intent(out), allocatable :: p + end subroutine + +! CHECK-LABEL: func.func @_QMmod1Psub15( +! CHECK-SAME: %[[ARG0:.*]]: !fir.ref>> {fir.bindc_name = "p"}) { +! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref>> +! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.class>) -> !fir.heap +! CHECK: %[[BOX_ADDR_PTR:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.heap) -> 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.ref> +! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: } + end module -- 2.7.4