diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index ab48ef422801a..0b5c3dde2e720 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -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) { diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index e3c2ce8099623..ef1f68f7e0ebc 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -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()) + 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) //===----------------------------------------------------------------===// @@ -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; } diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 25ffcb68eaf87..7d6ab2c83cc59 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -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 && diff --git a/flang/test/Lower/HLFIR/local-end-of-scope-component-dealloc.f90 b/flang/test/Lower/HLFIR/local-end-of-scope-component-dealloc.f90 new file mode 100644 index 0000000000000..b63026b1e3f10 --- /dev/null +++ b/flang/test/Lower/HLFIR/local-end-of-scope-component-dealloc.f90 @@ -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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box>}>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box>}>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_9]] = fir.convert %{{.*}} : (!fir.box>}>}>>) -> !fir.box + +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 : (!fir.box) -> none +! CHECK-DAG: %[[VAL_10]] = fir.convert %{{.*}} : (!fir.box>}>}>>) -> !fir.box