[flang-commits] [flang] [flang] Deallocate local allocatable at end of their scopes (PR #67036)
via flang-commits
flang-commits at lists.llvm.org
Thu Sep 21 23:56:40 PDT 2023
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/67036
>From 7d06e8a3b57e3b642edd84ecaba9cc4a600a3f51 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 21 Sep 2023 01:52:54 -0700
Subject: [PATCH 1/2] [flang] Deallocate local allocatable at end of their
scopes
Implement automatic deallocation of unsaved local alloctables when
reaching the end of their scope of block as described in Fortran
2018 9.7.3.2 point 2. and 3.
Uses genDeallocateIfAllocated used for intent(out) deallocation
and the "function context" already used for finalization at end of
scope.
---
flang/lib/Lower/ConvertVariable.cpp | 47 +++-
.../allocatable-end-of-scope-dealloc.f90 | 239 ++++++++++++++++++
flang/test/Lower/allocatable-polymorphic.f90 | 6 +-
3 files changed, 274 insertions(+), 18 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/allocatable-end-of-scope-dealloc.f90
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 1d74cf2daf5f302..ad6b780318c9e4c 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -652,26 +652,31 @@ defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter,
}
}
+enum class VariableCleanUp { Finalize, Deallocate };
/// Check whether a variable needs to be finalized according to clause 7.5.6.3
-/// point 3.
-/// Must be nonpointer, nonallocatable object that is not a dummy argument or
+/// point 3 or if it is an allocatable that must be deallocated.
+/// Must be nonpointer object that is not a dummy argument or
/// function result.
-static bool needEndFinalization(const Fortran::lower::pft::Variable &var) {
+static std::optional<VariableCleanUp>
+needEndFinalization(const Fortran::lower::pft::Variable &var) {
if (!var.hasSymbol())
- return false;
+ return std::nullopt;
const Fortran::semantics::Symbol &sym = var.getSymbol();
const Fortran::semantics::Scope &owner = sym.owner();
if (owner.kind() == Fortran::semantics::Scope::Kind::MainProgram) {
// The standard does not require finalizing main program variables.
- return false;
+ return std::nullopt;
}
if (!Fortran::semantics::IsPointer(sym) &&
- !Fortran::semantics::IsAllocatable(sym) &&
!Fortran::semantics::IsDummy(sym) &&
!Fortran::semantics::IsFunctionResult(sym) &&
- !Fortran::semantics::IsSaved(sym))
- return hasFinalization(sym);
- return false;
+ !Fortran::semantics::IsSaved(sym)) {
+ if (Fortran::semantics::IsAllocatable(sym))
+ return VariableCleanUp::Deallocate;
+ if (hasFinalization(sym))
+ return VariableCleanUp::Finalize;
+ }
+ return std::nullopt;
}
/// Check whether a variable needs the be finalized according to clause 7.5.6.3
@@ -779,15 +784,29 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
finalizeAtRuntime(converter, var, symMap);
if (mustBeDefaultInitializedAtRuntime(var))
defaultInitializeAtRuntime(converter, var, symMap);
- if (needEndFinalization(var)) {
+ if (std::optional<VariableCleanUp> cleanup = needEndFinalization(var)) {
auto *builder = &converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
fir::ExtendedValue exv =
converter.getSymbolExtendedValue(var.getSymbol(), &symMap);
- converter.getFctCtx().attachCleanup([builder, loc, exv]() {
- mlir::Value box = builder->createBox(loc, exv);
- fir::runtime::genDerivedTypeDestroy(*builder, loc, box);
- });
+ switch (*cleanup) {
+ case VariableCleanUp::Finalize:
+ converter.getFctCtx().attachCleanup([builder, loc, exv]() {
+ mlir::Value box = builder->createBox(loc, exv);
+ fir::runtime::genDerivedTypeDestroy(*builder, loc, box);
+ });
+ break;
+ case VariableCleanUp::Deallocate:
+ auto *converterPtr = &converter;
+ converter.getFctCtx().attachCleanup([converterPtr, loc, exv]() {
+ const fir::MutableBoxValue *mutableBox =
+ exv.getBoxOf<fir::MutableBoxValue>();
+ assert(mutableBox &&
+ "trying to deallocate entity not lowered as allocatable");
+ Fortran::lower::genDeallocateIfAllocated(*converterPtr, *mutableBox,
+ loc);
+ });
+ }
}
}
diff --git a/flang/test/Lower/HLFIR/allocatable-end-of-scope-dealloc.f90 b/flang/test/Lower/HLFIR/allocatable-end-of-scope-dealloc.f90
new file mode 100644
index 000000000000000..ad4b015ef9443fc
--- /dev/null
+++ b/flang/test/Lower/HLFIR/allocatable-end-of-scope-dealloc.f90
@@ -0,0 +1,239 @@
+! Test automatic deallocation of local allocatables as described in
+! Fortran 2018 standard 9.7.3.2 point 2. and 3.
+
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+module dtypedef
+ type must_finalize
+ integer :: i
+ contains
+ final :: finalize
+ end type
+ type contain_must_finalize
+ type(must_finalize) :: a
+ end type
+ interface
+ subroutine finalize(a)
+ import :: must_finalize
+ type(must_finalize), intent(inout) :: a
+ end subroutine
+ end interface
+ real, allocatable :: x
+end module
+
+subroutine simple()
+ real, allocatable :: x
+ allocate(x)
+ call bar()
+end subroutine
+! CHECK-LABEL: func.func @_QPsimple() {
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}"_QFsimpleEx"
+! CHECK: fir.call @_QPbar
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>>
+! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<f32>) -> i64
+! CHECK: %[[VAL_9:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_10:.*]] = arith.cmpi ne, %[[VAL_8]], %[[VAL_9]] : i64
+! CHECK: fir.if %[[VAL_10]] {
+! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>>
+! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+! CHECK: fir.freemem %[[VAL_12]] : !fir.heap<f32>
+! CHECK: %[[VAL_13:.*]] = fir.zero_bits !fir.heap<f32>
+! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] : (!fir.heap<f32>) -> !fir.box<!fir.heap<f32>>
+! CHECK: fir.store %[[VAL_14]] to %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>>
+! CHECK: }
+
+subroutine multiple_return(cdt)
+ real, allocatable :: x
+ logical :: cdt
+ allocate(x)
+ if (cdt) return
+ call bar()
+end subroutine
+! CHECK-LABEL: func.func @_QPmultiple_return(
+! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2
+! CHECK: ^bb1:
+! CHECK-NOT: fir.freemem
+! CHECK: cf.br ^bb3
+! CHECK: ^bb2:
+! CHECK: fir.call @_QPbar
+! CHECK: cf.br ^bb3
+! CHECK: ^bb3:
+! CHECK: fir.if {{.*}} {
+! CHECK: fir.freemem
+! CHECK: }
+! CHECK: return
+
+subroutine derived()
+ use dtypedef, only : must_finalize
+ type(must_finalize), allocatable :: x
+ allocate(x)
+ call bar()
+end subroutine
+! CHECK-LABEL: func.func @_QPderived() {
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}"_QFderivedEx"
+! CHECK: fir.call @_QPbar
+! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>>
+! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>) -> !fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>
+! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>) -> i64
+! CHECK: %[[VAL_14:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_15:.*]] = arith.cmpi ne, %[[VAL_13]], %[[VAL_14]] : i64
+! CHECK: fir.if %[[VAL_15]] {
+! CHECK: %[[VAL_16:.*]] = arith.constant false
+! CHECK: %[[VAL_17:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_3]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMdtypedefTmust_finalize{i:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_22:.*]] = fir.call @_FortranAAllocatableDeallocate(%[[VAL_20]], %[[VAL_16]], %[[VAL_17]], %{{.*}}, %{{.*}})
+! CHECK: }
+
+subroutine derived2()
+ use dtypedef, only : contain_must_finalize
+ type(contain_must_finalize), allocatable :: x
+ allocate(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPderived2(
+! CHECK: fir.if {{.*}} {
+! CHECK: fir.call @_FortranAAllocatableDeallocate
+! CHECK: }
+
+subroutine simple_block()
+ block
+ real, allocatable :: x
+ allocate(x)
+ call bar()
+ end block
+ call bar_after_block()
+end subroutine
+! CHECK-LABEL: func.func @_QPsimple_block(
+! CHECK: fir.call @_QPbar
+! CHECK: fir.if {{.*}} {
+! CHECK: fir.freemem
+! CHECK: }
+! CHECK: fir.call @_QPbar_after_block
+
+subroutine mutiple_return_block(cdt)
+ logical :: cdt
+ block
+ real, allocatable :: x
+ allocate(x)
+ if (cdt) return
+ call bar()
+ end block
+ call bar_after_block()
+end subroutine
+! CHECK-LABEL: func.func @_QPmutiple_return_block(
+! CHECK: cf.cond_br %{{.*}}, ^bb1, ^bb2
+! CHECK: ^bb1:
+! CHECK: fir.if {{.*}} {
+! CHECK: fir.freemem
+! CHECK: }
+! CHECK: cf.br ^bb3
+! CHECK: ^bb2:
+! CHECK: fir.call @_QPbar
+! CHECK: fir.if {{.*}} {
+! CHECK: fir.freemem
+! CHECK: }
+! CHECK: fir.call @_QPbar_after_block
+! CHECK: cf.br ^bb3
+! CHECK: ^bb3:
+! CHECK: return
+
+
+subroutine derived_block()
+ use dtypedef, only : must_finalize
+ block
+ type(must_finalize), allocatable :: x
+ allocate(x)
+ call bar()
+ end block
+ call bar_after_block()
+end subroutine
+! CHECK-LABEL: func.func @_QPderived_block(
+! CHECK: fir.call @_QPbar
+! CHECK: fir.if {{.*}} {
+! CHECK: fir.call @_FortranAAllocatableDeallocate
+! CHECK: }
+! CHECK: fir.call @_QPbar_after_block
+
+subroutine derived_block2()
+ use dtypedef, only : contain_must_finalize
+ call bar()
+ block
+ type(contain_must_finalize), allocatable :: x
+ allocate(x)
+ end block
+ call bar_after_block()
+end subroutine
+! CHECK-LABEL: func.func @_QPderived_block2(
+! CHECK: fir.call @_QPbar
+! CHECK: fir.if {{.*}} {
+! CHECK: fir.call @_FortranAAllocatableDeallocate
+! CHECK: }
+! CHECK: fir.call @_QPbar_after_block
+
+subroutine no_dealloc_saved()
+ real, allocatable, save :: x
+ allocate(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPno_dealloc_save
+! CHECK-NOT: freemem
+! CHECK-NOT: Deallocate
+! CHECK: return
+
+subroutine no_dealloc_block_saved()
+ block
+ real, allocatable, save :: x
+ allocate(x)
+ end block
+end subroutine
+! CHECK-LABEL: func.func @_QPno_dealloc_block_saved
+! CHECK-NOT: freemem
+! CHECK-NOT: Deallocate
+! CHECK: return
+
+function no_dealloc_result() result(x)
+ real, allocatable :: x
+ allocate(x)
+end function
+! CHECK-LABEL: func.func @_QPno_dealloc_result
+! CHECK-NOT: freemem
+! CHECK-NOT: Deallocate
+! CHECK: return
+
+subroutine no_dealloc_dummy(x)
+ real, allocatable :: x
+ allocate(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPno_dealloc_dummy
+! CHECK-NOT: freemem
+! CHECK-NOT: Deallocate
+! CHECK: return
+
+subroutine no_dealloc_module_var()
+ use dtypedef, only : x
+ allocate(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPno_dealloc_module_var
+! CHECK-NOT: freemem
+! CHECK-NOT: Deallocate
+! CHECK: return
+
+subroutine no_dealloc_host_assoc()
+ real, allocatable :: x
+ call internal()
+contains
+ subroutine internal()
+ allocate(x)
+ end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QFno_dealloc_host_assocPinternal
+! CHECK-NOT: freemem
+! CHECK-NOT: Deallocate
+! CHECK: return
+
+subroutine no_dealloc_pointer(x)
+ real, pointer :: x
+ allocate(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPno_dealloc_pointer
+! CHECK-NOT: freemem
+! CHECK-NOT: Deallocate
+! CHECK: return
diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90
index 148ae3be9f70a4f..53b257d2eaceaac 100644
--- a/flang/test/Lower/allocatable-polymorphic.f90
+++ b/flang/test/Lower/allocatable-polymorphic.f90
@@ -656,11 +656,9 @@ program test_alloc
! allocatable.
! LLVM-LABEL: define void @_QMpolyPtest_deallocate()
-! LLVM: %[[ALLOCA1:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }
-! LLVM: %[[ALLOCA2:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, i64 1
-! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } { ptr null, i64 ptrtoint (ptr getelementptr (%_QMpolyTp1, ptr null, i32 1) to i64), i32 20180515, i8 0, i8 42, i8 2, i8 1, ptr @_QMpolyE.dt.p1, [1 x i64] undef }, ptr %[[ALLOCA1]]
+! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } { ptr null, i64 ptrtoint (ptr getelementptr (%_QMpolyTp1, ptr null, i32 1) to i64), i32 20180515, i8 0, i8 42, i8 2, i8 1, ptr @_QMpolyE.dt.p1, [1 x i64] undef }, ptr %[[ALLOCA1:[0-9]*]]
! LLVM: %[[LOAD:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[ALLOCA1]]
-! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOAD]], ptr %[[ALLOCA2]]
+! LLVM: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOAD]], ptr %[[ALLOCA2:[0-9]*]]
! LLVM: %{{.*}} = call {} @_FortranAAllocatableInitDerivedForAllocate(ptr %[[ALLOCA2]], ptr @_QMpolyE.dt.p1, i32 0, i32 0)
! LLVM: %{{.*}} = call i32 @_FortranAAllocatableAllocate(ptr %[[ALLOCA2]], i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
! LLVM: %{{.*}} = call i32 @_FortranAAllocatableDeallocatePolymorphic(ptr %[[ALLOCA2]], ptr {{.*}}, i1 false, ptr null, ptr @_QQcl.{{.*}}, i32 {{.*}})
>From 862cd90aece57722d5e146f8c7464c5d3664bf51 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 21 Sep 2023 23:48:59 -0700
Subject: [PATCH 2/2] rename needEndFinalization as suggested
---
flang/lib/Lower/ConvertVariable.cpp | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index ad6b780318c9e4c..58d754668000ef3 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -653,12 +653,11 @@ defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter,
}
enum class VariableCleanUp { Finalize, Deallocate };
-/// Check whether a variable needs to be finalized according to clause 7.5.6.3
-/// point 3 or if it is an allocatable that must be deallocated.
-/// Must be nonpointer object that is not a dummy argument or
-/// function result.
+/// Check whether a local variable needs to be finalized according to clause
+/// 7.5.6.3 point 3 or if it is an allocatable that must be deallocated. Note
+/// that deallocation will trigger finalization if the type has any.
static std::optional<VariableCleanUp>
-needEndFinalization(const Fortran::lower::pft::Variable &var) {
+needDeallocationOrFinalization(const Fortran::lower::pft::Variable &var) {
if (!var.hasSymbol())
return std::nullopt;
const Fortran::semantics::Symbol &sym = var.getSymbol();
@@ -784,7 +783,8 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
finalizeAtRuntime(converter, var, symMap);
if (mustBeDefaultInitializedAtRuntime(var))
defaultInitializeAtRuntime(converter, var, symMap);
- if (std::optional<VariableCleanUp> cleanup = needEndFinalization(var)) {
+ if (std::optional<VariableCleanUp> cleanup =
+ needDeallocationOrFinalization(var)) {
auto *builder = &converter.getFirOpBuilder();
mlir::Location loc = converter.getCurrentLocation();
fir::ExtendedValue exv =
More information about the flang-commits
mailing list