[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 09:45:09 PDT 2023
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-fir-hlfir
<details>
<summary>Changes</summary>
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.
---
Full diff: https://github.com/llvm/llvm-project/pull/67036.diff
3 Files Affected:
- (modified) flang/lib/Lower/ConvertVariable.cpp (+33-14)
- (added) flang/test/Lower/HLFIR/allocatable-end-of-scope-dealloc.f90 (+239)
- (modified) flang/test/Lower/allocatable-polymorphic.f90 (+2-4)
``````````diff
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 {{.*}})
``````````
</details>
https://github.com/llvm/llvm-project/pull/67036
More information about the flang-commits
mailing list