Skip to content

Commit

Permalink
[flang] Deallocate components of local variables at the end of the sc…
Browse files Browse the repository at this point in the history
…ope. (llvm#68064)

Call Destroy runtime for local variables of derived types with
allocatable components.
  • Loading branch information
vzakhari authored Oct 3, 2023
1 parent cfe8ae3 commit be66a2f
Show file tree
Hide file tree
Showing 4 changed files with 138 additions and 0 deletions.
2 changes: 2 additions & 0 deletions flang/include/flang/Semantics/tools.h
Original file line number Diff line number Diff line change
Expand Up @@ -180,6 +180,8 @@ const Symbol *HasImpureFinal(const Symbol &);
// Is this type finalizable or does it contain any polymorphic allocatable
// ultimate components?
bool MayRequireFinalization(const DerivedTypeSpec &derived);
// Does this type have an allocatable direct component?
bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived);

bool IsInBlankCommon(const Symbol &);
inline bool IsAssumedSizeArray(const Symbol &symbol) {
Expand Down
20 changes: 20 additions & 0 deletions flang/lib/Lower/ConvertVariable.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,17 @@ static bool hasFinalization(const Fortran::semantics::Symbol &sym) {
return false;
}

// Does this variable have an allocatable direct component?
static bool
hasAllocatableDirectComponent(const Fortran::semantics::Symbol &sym) {
if (sym.has<Fortran::semantics::ObjectEntityDetails>())
if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
declTypeSpec->AsDerived())
return Fortran::semantics::HasAllocatableDirectComponent(
*derivedTypeSpec);
return false;
}
//===----------------------------------------------------------------===//
// Global variables instantiation (not for alias and common)
//===----------------------------------------------------------------===//
Expand Down Expand Up @@ -670,6 +681,15 @@ needDeallocationOrFinalization(const Fortran::lower::pft::Variable &var) {
return VariableCleanUp::Deallocate;
if (hasFinalization(sym))
return VariableCleanUp::Finalize;
// hasFinalization() check above handled all cases that require
// finalization, but we also have to deallocate all allocatable
// components of local variables (since they are also local variables
// according to F18 5.4.3.2.2, p. 2, note 1).
// Here, the variable itself is not allocatable. If it has an allocatable
// component the Destroy runtime does the job. Use the Finalize clean-up,
// though there will be no finalization in runtime.
if (hasAllocatableDirectComponent(sym))
return VariableCleanUp::Finalize;
}
return std::nullopt;
}
Expand Down
5 changes: 5 additions & 0 deletions flang/lib/Semantics/tools.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -841,6 +841,11 @@ bool MayRequireFinalization(const DerivedTypeSpec &derived) {
FindPolymorphicAllocatableUltimateComponent(derived);
}

bool HasAllocatableDirectComponent(const DerivedTypeSpec &derived) {
DirectComponentIterator directs{derived};
return std::any_of(directs.begin(), directs.end(), IsAllocatable);
}

bool IsAssumedLengthCharacter(const Symbol &symbol) {
if (const DeclTypeSpec * type{symbol.GetType()}) {
return type->category() == DeclTypeSpec::Character &&
Expand Down
111 changes: 111 additions & 0 deletions flang/test/Lower/HLFIR/local-end-of-scope-component-dealloc.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,111 @@
! Test automatic deallocation of allocatable components
! of local variables as described in Fortran 2018 standard
! 9.7.3.2 point 2. and 3.
! The allocatable components of local variables are local variables
! themselves due to 5.4.3.2.2 p. 2, note 1.
! RUN: bbc -emit-hlfir -o - -I nowhere %s | FileCheck %s

module types
type t1
real, allocatable :: x
end type t1
type t2
type(t1) :: x
end type t2
type, extends(t1) :: t3
end type t3
type, extends(t3) :: t4
end type t4
type, extends(t2) :: t5
end type t5
end module types

subroutine test1()
use types
type(t1) :: x1
end subroutine test1
! CHECK-LABEL: func.func @_QPtest1() {
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>

subroutine test1b()
use types
block
type(t1) :: x1
end block
end subroutine test1b
! CHECK-LABEL: func.func @_QPtest1b() {
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>

subroutine test2()
use types
type(t2) :: x2
end subroutine test2
! CHECK-LABEL: func.func @_QPtest2() {
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt2{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>

subroutine test2b()
use types
block
type(t2) :: x2
end block
end subroutine test2b
! CHECK-LABEL: func.func @_QPtest2b() {
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt2{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>

subroutine test3()
use types
type(t3) :: x3
end subroutine test3
! CHECK-LABEL: func.func @_QPtest3() {
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt3{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>

subroutine test3b()
use types
block
type(t3) :: x3
end block
end subroutine test3b
! CHECK-LABEL: func.func @_QPtest3b() {
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt3{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>

subroutine test4()
use types
type(t4) :: x4
end subroutine test4
! CHECK-LABEL: func.func @_QPtest4() {
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt4{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>

subroutine test4b()
use types
block
type(t4) :: x4
end block
end subroutine test4b
! CHECK-LABEL: func.func @_QPtest4b() {
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt4{x:!fir.box<!fir.heap<f32>>}>>) -> !fir.box<none>

subroutine test5()
use types
type(t5) :: x5
end subroutine test5
! CHECK-LABEL: func.func @_QPtest5() {
! CHECK-DAG: %[[VAL_10:.*]] = fir.call @_FortranADestroy(%[[VAL_9:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt5{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>

subroutine test5b()
use types
block
type(t5) :: x5
end block
end subroutine test5b
! CHECK-LABEL: func.func @_QPtest5b() {
! CHECK-DAG: %[[VAL_11:.*]] = fir.call @_FortranADestroy(%[[VAL_10:.*]]) fastmath<contract> : (!fir.box<none>) -> none
! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box<!fir.type<_QMtypesTt5{x:!fir.type<_QMtypesTt1{x:!fir.box<!fir.heap<f32>>}>}>>) -> !fir.box<none>

0 comments on commit be66a2f

Please sign in to comment.