[flang-commits] [flang] 30dc037 - [flang] Avoid double cleanup when the result is cleaned up by the Destroy function

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-06T17:46:39+01:00
New Revision: 30dc03796894339ceb64f86cbc95f75ea7b78791

URL: https://github.com/llvm/llvm-project/commit/30dc03796894339ceb64f86cbc95f75ea7b78791
DIFF: https://github.com/llvm/llvm-project/commit/30dc03796894339ceb64f86cbc95f75ea7b78791.diff

LOG: [flang] Avoid double cleanup when the result is cleaned up by the Destroy function

The Destroy runtime function does free the memory so do not do it
inlined when we use Destroy. This avoid a double free execution error.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D145372

Added: 
    

Modified: 
    flang/lib/Lower/ConvertCall.cpp
    flang/test/Lower/derived-type-finalization.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 6418d7dcb82c..06fa99fe69ea 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -415,6 +415,7 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
     // in any cases.
     std::optional<Fortran::evaluate::DynamicType> retTy =
         caller.getCallDescription().proc().GetType();
+    bool cleanupWithDestroy = false;
     if (!fir::isPointerType(funcType.getResults()[0]) && retTy &&
         (retTy->category() == Fortran::common::TypeCategory::Derived ||
          retTy->IsPolymorphic() || retTy->IsUnlimitedPolymorphic())) {
@@ -424,6 +425,7 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
           fir::runtime::genDerivedTypeDestroy(*bldr, loc,
                                               fir::getBase(*allocatedResult));
         });
+        cleanupWithDestroy = true;
       } else {
         const Fortran::semantics::DerivedTypeSpec &typeSpec =
             retTy->GetDerivedTypeSpec();
@@ -433,12 +435,13 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
             mlir::Value box = bldr->createBox(loc, *allocatedResult);
             fir::runtime::genDerivedTypeDestroy(*bldr, loc, box);
           });
+          cleanupWithDestroy = true;
         }
       }
     }
     allocatedResult->match(
         [&](const fir::MutableBoxValue &box) {
-          if (box.isAllocatable()) {
+          if (box.isAllocatable() && !cleanupWithDestroy) {
             // 9.7.3.2 point 4. Finalize allocatables.
             fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
             stmtCtx.attachCleanup([bldr, loc, box]() {

diff  --git a/flang/test/Lower/derived-type-finalization.f90 b/flang/test/Lower/derived-type-finalization.f90
index 8de16bc986f0..a93581ac025e 100644
--- a/flang/test/Lower/derived-type-finalization.f90
+++ b/flang/test/Lower/derived-type-finalization.f90
@@ -10,6 +10,7 @@ module derived_type_finalization
     integer :: a
   contains
     final :: t1_final
+    final :: t1_final_1r
   end type
 
   type :: t2
@@ -28,6 +29,10 @@ subroutine t1_final(this)
     type(t1) :: this
   end subroutine
 
+  subroutine t1_final_1r(this)
+    type(t1) :: this(:)
+  end subroutine
+
   subroutine t2_final(this)
     type(t2) :: this
   end subroutine
@@ -203,6 +208,25 @@ function no_func_ret_finalize() result(ty)
 ! CHECK: %{{.*}} = fir.call @_FortranADestroy
 ! CHECK: return %{{.*}} : !fir.type<_QMderived_type_finalizationTt1{a:i32}>
 
+  function copy(a) result(ty)
+    class(t1), allocatable :: ty(:)
+    integer, intent(in) :: a
+    allocate(t1::ty(a))
+    ty%a = 1
+  end function
+
+  subroutine test_avoid_double_free()
+    class(*), allocatable :: up(:)
+    allocate(up(10), source=copy(10))
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_avoid_double_free() {
+! CHECK: %[[RES:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>> {bindc_name = ".result"}
+! CHECK: fir.call @_FortranAAllocatableAllocateSource(
+! CHECK-NOT: fir.freemem %{{.*}} : !fir.heap<!fir.array<?x!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>
+! CHECK: %[[RES_CONV:.*]] = fir.convert %[[RES]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[RES_CONV]]) {{.*}} : (!fir.box<none>) -> none
+
 end module
 
 program p