[flang-commits] [flang] [flang][hlfir] Fixed missing deallocation for components of function … (PR #67768)
via flang-commits
flang-commits at lists.llvm.org
Thu Sep 28 23:43:48 PDT 2023
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-fir-hlfir
<details>
<summary>Changes</summary>
…result.
If function result have allocatable components or components that may require finalization, we have to call Destroy runtime for them. We also have to free the top-level entity's memory regardless of whether we called Destroy or not.
---
Full diff: https://github.com/llvm/llvm-project/pull/67768.diff
2 Files Affected:
- (modified) flang/lib/Lower/ConvertCall.cpp (+30-18)
- (added) flang/test/Lower/HLFIR/function-return-destroy.f90 (+197)
``````````diff
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 0510965a596fb05..09b1b3ab7f5aa34 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -428,6 +428,29 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
}
if (allocatedResult) {
+ // The result must be optionally destroyed (if it is of a derived type
+ // that may need finalization or deallocation of the components).
+ // For an allocatable result we have to free the memory allocated
+ // for the top-level entity. Note that the Destroy calls below
+ // do not deallocate the top-level entity. The two clean-ups
+ // must be pushed in reverse order, so that the final order is:
+ // Destroy(desc)
+ // free(desc->base_addr)
+ allocatedResult->match(
+ [&](const fir::MutableBoxValue &box) {
+ if (box.isAllocatable()) {
+ // 9.7.3.2 point 4. Deallocate allocatable results. Note that
+ // finalization was done independently by calling
+ // genDerivedTypeDestroy above and is not triggered by this inline
+ // deallocation.
+ fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
+ stmtCtx.attachCleanup([bldr, loc, box]() {
+ fir::factory::genFreememIfAllocated(*bldr, loc, box);
+ });
+ }
+ },
+ [](const auto &) {});
+
// 7.5.6.3 point 5. Derived-type finalization for nonpointer function.
// Check if the derived-type is finalizable if it is a monomorphic
// derived-type.
@@ -435,7 +458,6 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
// in any cases.
std::optional<Fortran::evaluate::DynamicType> retTy =
caller.getCallDescription().proc().GetType();
- bool cleanupWithDestroy = false;
// With HLFIR lowering, isElemental must be set to true
// if we are producing an elemental call. In this case,
// the elemental results must not be destroyed, instead,
@@ -451,34 +473,24 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
fir::runtime::genDerivedTypeDestroy(*bldr, loc,
fir::getBase(*allocatedResult));
});
- cleanupWithDestroy = true;
} else {
const Fortran::semantics::DerivedTypeSpec &typeSpec =
retTy->GetDerivedTypeSpec();
- if (Fortran::semantics::IsFinalizable(typeSpec)) {
+ // If the result type is finalizable or may require finalization
+ // or have allocatable components, we need to make sure
+ // everything is properly finalized/deallocated.
+ if (Fortran::semantics::IsFinalizable(typeSpec) ||
+ Fortran::semantics::MayRequireFinalization(typeSpec) ||
+ // We can use DerivedTypeDestroy even if finalization is not needed.
+ hlfir::mayHaveAllocatableComponent(funcType.getResults()[0])) {
auto *bldr = &converter.getFirOpBuilder();
stmtCtx.attachCleanup([bldr, loc, allocatedResult]() {
mlir::Value box = bldr->createBox(loc, *allocatedResult);
fir::runtime::genDerivedTypeDestroy(*bldr, loc, box);
});
- cleanupWithDestroy = true;
}
}
}
- allocatedResult->match(
- [&](const fir::MutableBoxValue &box) {
- if (box.isAllocatable() && !cleanupWithDestroy) {
- // 9.7.3.2 point 4. Deallocate allocatable results. Note that
- // finalization was done independently by calling
- // genDerivedTypeDestroy above and is not triggered by this inline
- // deallocation.
- fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
- stmtCtx.attachCleanup([bldr, loc, box]() {
- fir::factory::genFreememIfAllocated(*bldr, loc, box);
- });
- }
- },
- [](const auto &) {});
return *allocatedResult;
}
diff --git a/flang/test/Lower/HLFIR/function-return-destroy.f90 b/flang/test/Lower/HLFIR/function-return-destroy.f90
new file mode 100644
index 000000000000000..4663dc57e0457f5
--- /dev/null
+++ b/flang/test/Lower/HLFIR/function-return-destroy.f90
@@ -0,0 +1,197 @@
+! RUN: bbc -emit-hlfir -polymorphic-type %s -o - -I nowhere | FileCheck %s
+
+module types
+ type t1
+ real :: x
+ end type t1
+ type t2
+ real, allocatable :: x
+ end type t2
+ type t3
+ real, pointer :: p
+ end type t3
+ type t4
+ type(t1) :: c
+ end type t4
+ type t5
+ type(t2) :: c
+ end type t5
+ type t6
+ contains
+ final :: finalize_t6
+ end type t6
+ type, extends(t1) :: t7
+ end type t7
+ type, extends(t2) :: t8
+ end type t8
+ type, extends(t6) :: t9
+ end type t9
+contains
+ subroutine finalize_t6(x)
+ type(t6), intent(inout) :: x
+ end subroutine finalize_t6
+end module types
+
+subroutine test1
+ use types
+ interface
+ function ret_type_t1
+ use types
+ type(t1) :: ret_type_t1
+ end function ret_type_t1
+ end interface
+ type(t1) :: x
+ x = ret_type_t1()
+end subroutine test1
+! CHECK-LABEL: func.func @_QPtest1() {
+! CHECK-NOT: fir.call{{.*}}Destroy
+
+subroutine test1a
+ use types
+ interface
+ function ret_type_t1a
+ use types
+ type(t1), allocatable :: ret_type_t1a
+ end function ret_type_t1a
+ end interface
+ type(t1), allocatable :: x
+ x = ret_type_t1a()
+end subroutine test1a
+! CHECK-LABEL: func.func @_QPtest1a() {
+! CHECK-NOT: fir.call{{.*}}Destroy
+! CHECK: fir.if %{{.*}} {
+! CHECK-NEXT: fir.freemem %{{.*}} : !fir.heap<!fir.type<_QMtypesTt1{x:f32}>>
+! CHECK-NOT: fir.call{{.*}}Destroy
+! CHECK: fir.if %{{.*}} {
+! CHECK: fir.call @_FortranAAllocatableDeallocate({{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-NOT: fir.call{{.*}}Destroy
+
+subroutine test1c
+ use types
+ interface
+ function ret_class_t1
+ use types
+ class(t1), allocatable :: ret_class_t1
+ end function ret_class_t1
+ end interface
+ type(t1) :: x
+ x = ret_class_t1()
+end subroutine test1c
+! CHECK-LABEL: func.func @_QPtest1c() {
+! CHECK: fir.call @_FortranADestroy
+! CHECK: fir.if %{{.*}} {
+! CHECK-NEXT: fir.freemem %{{.*}} : !fir.heap<!fir.type<_QMtypesTt1{x:f32}>>
+
+subroutine test2
+ use types
+ interface
+ function ret_type_t2
+ use types
+ type(t2) :: ret_type_t2
+ end function ret_type_t2
+ end interface
+ type(t2) :: x
+ x = ret_type_t2()
+end subroutine test2
+! CHECK-LABEL: func.func @_QPtest2() {
+! CHECK: fir.call @_FortranADestroy
+
+subroutine test3
+ use types
+ interface
+ function ret_type_t3
+ use types
+ type(t3) :: ret_type_t3
+ end function ret_type_t3
+ end interface
+ type(t3) :: x
+ x = ret_type_t3()
+end subroutine test3
+! CHECK-LABEL: func.func @_QPtest3() {
+! CHECK-NOT: fir.call{{.*}}Destroy
+
+subroutine test4
+ use types
+ interface
+ function ret_type_t4
+ use types
+ type(t4) :: ret_type_t4
+ end function ret_type_t4
+ end interface
+ type(t4) :: x
+ x = ret_type_t4()
+end subroutine test4
+! CHECK-LABEL: func.func @_QPtest4() {
+! CHECK-NOT: fir.call{{.*}}Destroy
+
+subroutine test5
+ use types
+ interface
+ function ret_type_t5
+ use types
+ type(t5) :: ret_type_t5
+ end function ret_type_t5
+ end interface
+ type(t5) :: x
+ x = ret_type_t5()
+end subroutine test5
+! CHECK-LABEL: func.func @_QPtest5() {
+! CHECK: fir.call @_FortranADestroy
+
+subroutine test6
+ use types
+ interface
+ function ret_type_t6
+ use types
+ type(t6) :: ret_type_t6
+ end function ret_type_t6
+ end interface
+ type(t6) :: x
+ x = ret_type_t6()
+end subroutine test6
+! CHECK-LABEL: func.func @_QPtest6() {
+! CHECK: fir.call @_FortranADestroy
+! CHECK: fir.call @_FortranADestroy
+
+subroutine test7
+ use types
+ interface
+ function ret_type_t7
+ use types
+ type(t7) :: ret_type_t7
+ end function ret_type_t7
+ end interface
+ type(t7) :: x
+ x = ret_type_t7()
+end subroutine test7
+! CHECK-LABEL: func.func @_QPtest7() {
+! CHECK-NOT: fir.call{{.*}}Destroy
+
+subroutine test8
+ use types
+ interface
+ function ret_type_t8
+ use types
+ type(t8) :: ret_type_t8
+ end function ret_type_t8
+ end interface
+ type(t8) :: x
+ x = ret_type_t8()
+end subroutine test8
+! CHECK-LABEL: func.func @_QPtest8() {
+! CHECK: fir.call @_FortranADestroy
+
+subroutine test9
+ use types
+ interface
+ function ret_type_t9
+ use types
+ type(t9) :: ret_type_t9
+ end function ret_type_t9
+ end interface
+ type(t9) :: x
+ x = ret_type_t9()
+end subroutine test9
+! CHECK-LABEL: func.func @_QPtest9() {
+! CHECK: fir.call @_FortranADestroy
+! CHECK: fir.call @_FortranADestroy
``````````
</details>
https://github.com/llvm/llvm-project/pull/67768
More information about the flang-commits
mailing list