[flang-commits] [flang] 0c7d0ad - [flang] Deallocate local allocatable at end of their scopes (#67036)
via flang-commits
flang-commits at lists.llvm.org
Thu Sep 21 23:58:20 PDT 2023
Author: jeanPerier
Date: 2023-09-22T08:58:16+02:00
New Revision: 0c7d0ad9f7e61af35b3afa2da5b94520100bbdfd
URL: https://github.com/llvm/llvm-project/commit/0c7d0ad9f7e61af35b3afa2da5b94520100bbdfd
DIFF: https://github.com/llvm/llvm-project/commit/0c7d0ad9f7e61af35b3afa2da5b94520100bbdfd.diff
LOG: [flang] Deallocate local allocatable at end of their scopes (#67036)
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.
Added:
flang/test/Lower/HLFIR/allocatable-end-of-scope-dealloc.f90
Modified:
flang/lib/Lower/ConvertVariable.cpp
flang/test/Lower/allocatable-polymorphic.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 1d74cf2daf5f302..58d754668000ef3 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -652,26 +652,30 @@ defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter,
}
}
-/// 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
-/// function result.
-static bool needEndFinalization(const Fortran::lower::pft::Variable &var) {
+enum class VariableCleanUp { Finalize, Deallocate };
+/// 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>
+needDeallocationOrFinalization(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 +783,30 @@ 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 =
+ needDeallocationOrFinalization(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 {{.*}})
More information about the flang-commits
mailing list