[flang] Deallocate local allocatable at end of their scopes #67036
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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.
|
@llvm/pr-subscribers-flang-fir-hlfir ChangesImplement 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:
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 {{.*}})
|
vdonaldson
approved these changes
Sep 21, 2023
There was a problem hiding this comment.
Jean, thanks for adding this missing piece of scope exit processing.
You might want to rename needEndFinalization to something like needDeallocationOrFinalization. (Well, it's really and/or, but ok.)
It might be helpful to have a comment somewhere that says that deallocation code will also do finalization if applicable.
|
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
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.