[flang-commits] [flang] 273b335 - [flang] Deallocate intent(out) allocatables
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Thu Sep 8 01:16:03 PDT 2022
Author: Valentin Clement
Date: 2022-09-08T10:15:54+02:00
New Revision: 273b3350d2700b7f2a4e367594bb4ba12e0b8e8e
URL: https://github.com/llvm/llvm-project/commit/273b3350d2700b7f2a4e367594bb4ba12e0b8e8e
DIFF: https://github.com/llvm/llvm-project/commit/273b3350d2700b7f2a4e367594bb4ba12e0b8e8e.diff
LOG: [flang] Deallocate intent(out) allocatables
>From Fortran 2018 standard 9.7.3.2 point 6:
When a procedure is invoked, any allocated allocatable object that is an actual
argument corresponding to an INTENT (OUT) allocatable dummy argument is
deallocated; any allocated allocatable object that is a subobject of an actual
argument corresponding to an INTENT (OUT) dummy argument is deallocated.
Deallocation is done on the callee side. For BIND(C) procedure, the deallocation
is also done on the caller side.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D133348
Added:
flang/test/Lower/intentout-deallocate.f90
Modified:
flang/include/flang/Lower/Allocatable.h
flang/include/flang/Lower/CallInterface.h
flang/lib/Lower/Allocatable.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/ConvertVariable.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/Allocatable.h b/flang/include/flang/Lower/Allocatable.h
index a54daad953fa5..7776f0455d34a 100644
--- a/flang/include/flang/Lower/Allocatable.h
+++ b/flang/include/flang/Lower/Allocatable.h
@@ -48,6 +48,9 @@ void genAllocateStmt(AbstractConverter &converter,
void genDeallocateStmt(AbstractConverter &converter,
const parser::DeallocateStmt &stmt, mlir::Location loc);
+void genDeallocateBox(AbstractConverter &converter,
+ const fir::MutableBoxValue &box, mlir::Location loc);
+
/// Create a MutableBoxValue for an allocatable or pointer entity.
/// If the variables is a local variable that is not a dummy, it will be
/// initialized to unallocated/diassociated status.
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 06724e0021237..0a8bad0677994 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -159,6 +159,8 @@ class CallInterface {
bool mayBeModifiedByCall() const;
/// Can the argument be read by the callee ?
bool mayBeReadByCall() const;
+ /// Is the argument INTENT(OUT)
+ bool isIntentOut() const;
/// How entity is passed by.
PassEntityBy passBy;
/// What is the entity (SymbolRef for callee/ActualArgument* for caller)
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 08a944440f168..8d0db01f9388d 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -523,6 +523,17 @@ static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
errorManager.assignStat(builder, loc, stat);
}
+void Fortran::lower::genDeallocateBox(
+ Fortran::lower::AbstractConverter &converter,
+ const fir::MutableBoxValue &box, mlir::Location loc) {
+ const Fortran::lower::SomeExpr *statExpr = nullptr;
+ const Fortran::lower::SomeExpr *errMsgExpr = nullptr;
+ ErrorManager errorManager;
+ errorManager.init(converter, loc, statExpr, errMsgExpr);
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ genDeallocate(builder, loc, box, errorManager);
+}
+
void Fortran::lower::genDeallocateStmt(
Fortran::lower::AbstractConverter &converter,
const Fortran::parser::DeallocateStmt &stmt, mlir::Location loc) {
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 5928149c03f6c..5b77d02344b61 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1048,6 +1048,12 @@ bool Fortran::lower::CallInterface<T>::PassedEntity::mayBeReadByCall() const {
return true;
return characteristics->GetIntent() != Fortran::common::Intent::Out;
}
+template <typename T>
+bool Fortran::lower::CallInterface<T>::PassedEntity::isIntentOut() const {
+ if (!characteristics)
+ return true;
+ return characteristics->GetIntent() == Fortran::common::Intent::Out;
+}
template <typename T>
void Fortran::lower::CallInterface<T>::determineInterface(
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 209ebf15451bc..91f2327aa547d 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -3239,6 +3239,9 @@ class ScalarExprLowering {
caller.placeInput(arg, irBox);
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);
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 b99952d75b6e8..a47b8f74e7709 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -603,6 +603,38 @@ defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter,
}
}
+// Fortran 2018 - 9.7.3.2 point 6
+// When a procedure is invoked, any allocated allocatable object that is an
+// actual argument corresponding to an INTENT(OUT) allocatable dummy argument
+// is deallocated; any allocated allocatable object that is a subobject of an
+// actual argument corresponding to an INTENT(OUT) dummy argument is
+// deallocated.
+static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
+ const Fortran::lower::pft::Variable &var,
+ Fortran::lower::SymMap &symMap) {
+ const Fortran::semantics::Symbol &sym = var.getSymbol();
+ if (Fortran::semantics::IsDummy(sym) &&
+ Fortran::semantics::IsIntentOut(sym) &&
+ Fortran::semantics::IsAllocatable(sym)) {
+ if (auto symbox = symMap.lookupSymbol(sym)) {
+ fir::ExtendedValue extVal = symbox.toExtendedValue();
+ if (auto mutBox = extVal.getBoxOf<fir::MutableBoxValue>()) {
+ mlir::Location loc = converter.getCurrentLocation();
+ 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);
+ }
+ }
+ }
+ }
+}
+
/// Instantiate a local variable. Precondition: Each variable will be visited
/// such that if its properties depend on other variables, the variables upon
/// which its properties depend will already have been visited.
@@ -612,6 +644,7 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
assert(!var.isAlias());
Fortran::lower::StatementContext stmtCtx;
mapSymbolAttributes(converter, var, symMap, stmtCtx);
+ deallocateIntentOut(converter, var, symMap);
if (mustBeDefaultInitializedAtRuntime(var))
defaultInitializeAtRuntime(converter, var, symMap);
}
diff --git a/flang/test/Lower/intentout-deallocate.f90 b/flang/test/Lower/intentout-deallocate.f90
new file mode 100644
index 0000000000000..b754698b724ef
--- /dev/null
+++ b/flang/test/Lower/intentout-deallocate.f90
@@ -0,0 +1,145 @@
+! Test correct deallocation of intent(out) allocatables.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+module mod1
+ type, bind(c) :: t1
+ integer :: i
+ end type
+
+ interface
+ subroutine sub3(a) bind(c)
+ integer, intent(out), allocatable :: a(:)
+ end subroutine
+ end interface
+
+ interface
+ subroutine sub7(t) bind(c)
+ import :: t1
+ type(t1), allocatable, intent(out) :: t
+ end subroutine
+ end interface
+
+contains
+ subroutine sub0()
+ integer, allocatable :: a(:)
+ allocate(a(10))
+ call sub1(a)
+ end subroutine
+
+ subroutine sub1(a)
+ integer, intent(out), allocatable :: a(:)
+ end subroutine
+
+! Make sure there is no deallocation of the allocatable intent(out) on the
+! caller side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub0()
+! CHECK-NOT: fir.freemem
+! CHECK: fir.call @_QMmod1Psub1
+
+! Check inline deallocation of allocatable intent(out) on the callee side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub1(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "a"})
+! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.freemem %[[BOX_ADDR]] : !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[EMBOX]] to %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+
+ subroutine sub2()
+ integer, allocatable :: a(:)
+ allocate(a(10))
+ call sub3(a)
+ end subroutine
+
+! Check inlined deallocation of allocatble intent(out) on the caller side for BIND(C).
+
+! CHECK-LABEL: func.func @_QMmod1Psub2()
+! CHECK: %[[BOX:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "a", uniq_name = "_QMmod1Fsub2Ea"}
+! CHECK: %[[BOX_ALLOC:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {uniq_name = "_QMmod1Fsub2Ea.addr"}
+! CHECK: %[[LOAD:.*]] = fir.load %[[BOX_ALLOC]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %{{.*}} = fir.embox %[[LOAD]](%{{.*}}) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<
+! CHECK: %[[LOAD:.*]] = fir.load %[[BOX_ALLOC]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.freemem %[[LOAD]] : !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[ZERO]] to %[[BOX_ALLOC]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.call @sub3(%[[BOX]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> ()
+
+ subroutine sub4()
+ type(t1), allocatable :: t
+ call sub5(t)
+ end subroutine
+
+ subroutine sub5(t)
+ type(t1), allocatable, intent(out) :: t
+ end subroutine
+
+! Make sure there is no deallocation runtime call of the allocatable intent(out)
+! on the caller side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub4()
+! CHECK: %[[BOX:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>> {bindc_name = "t", uniq_name = "_QMmod1Fsub4Et"}
+! CHECK-NOT: fir.call @_FortranAAllocatableDeallocate
+! CHECK: fir.call @_QMmod1Psub5(%[[BOX]]) : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> ()
+
+! Check deallocation of allocatble intent(out) on the callee side. Deallocation
+! is done with a runtime call.
+
+! 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
+
+ subroutine sub6()
+ type(t1), allocatable :: t
+ call sub7(t)
+ end subroutine
+
+! Check deallocation of allocatble intent(out) on the caller side for BIND(C).
+! Deallocation is done with a runtime call.
+
+! CHECK-LABEL: func.func @_QMmod1Psub6()
+! CHECK: %[[BOX:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>> {bindc_name = "t", uniq_name = "_QMmod1Fsub6Et"}
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!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: fir.call @sub7(%[[BOX]]) : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMmod1Tt1{i:i32}>>>>) -> ()
+
+ subroutine sub8()
+ integer, allocatable :: a(:)
+ allocate(a(10))
+ call sub9(a)
+ end subroutine
+
+ subroutine sub9(a)
+ integer, intent(out), allocatable, optional :: a(:)
+ end subroutine
+
+! Make sure there is no deallocation of the allocatable intent(out) on the
+! caller side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub8()
+! CHECK-NOT: fir.freemem
+! CHECK: fir.call @_QMmod1Psub9
+
+! Check inline deallocation of optional allocatable intent(out) on the callee side.
+
+! CHECK-LABEL: func.func @_QMmod1Psub9(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "a", fir.optional})
+! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[ARG0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> i1
+! CHECK: fir.if %[[IS_PRESENT]] {
+! CHECK: %[[BOX:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.freemem %[[BOX_ADDR]] : !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: %[[C0:.*]] = arith.constant 0 : index
+! CHECK: %[[SHAPE:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+! CHECK: fir.store %[[EMBOX]] to %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK: }
+
+end module
+
More information about the flang-commits
mailing list