Skip to content

[flang] Deallocate local allocatable at end of their scopes #67036

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Sep 22, 2023
Merged

[flang] Deallocate local allocatable at end of their scopes #67036

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
7d06e8a
[flang] Deallocate local allocatable at end of their scopes
jeanPerier Sep 21, 2023
862cd90
rename needEndFinalization as suggested
jeanPerier Sep 22, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
51 changes: 35 additions & 16 deletions flang/lib/Lower/ConvertVariable.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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);
});
}
}
}

Expand Down
239 changes: 239 additions & 0 deletions flang/test/Lower/HLFIR/allocatable-end-of-scope-dealloc.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
6 changes: 2 additions & 4 deletions flang/test/Lower/allocatable-polymorphic.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 {{.*}})