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

[clementval]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/ConvertCall.cpp

fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   if (allocatedResult) {
     // 7.5.6.3 point 5. Derived-type finalization for nonpointer function.
     // Check if the derived-type is finalizable if it is a monorphic
     // derived-type.
     // For polymorphic and unlimited polymorphic enities call the runtime
     // 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())) {
       if (retTy->IsPolymorphic() || retTy->IsUnlimitedPolymorphic()) {
         auto *bldr = &converter.getFirOpBuilder();
         stmtCtx.attachCleanup([bldr, loc, allocatedResult]() {
           fir::runtime::genDerivedTypeDestroy(*bldr, loc,
                                               fir::getBase(*allocatedResult));
         });
+        cleanupWithDestroy = true;
       } else {
         const Fortran::semantics::DerivedTypeSpec &typeSpec =
             retTy->GetDerivedTypeSpec();
         if (Fortran::semantics::IsFinalizable(typeSpec)) {
           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()) {
+          if (box.isAllocatable() && !cleanupWithDestroy) {
             // 9.7.3.2 point 4. Finalize allocatables.
             fir::FirOpBuilder *bldr = &converter.getFirOpBuilder();
             stmtCtx.attachCleanup([bldr, loc, box]() {
               fir::factory::genFinalization(*bldr, loc, box);
             });
           }
         },
         [](const auto &) {});

flang/test/Lower/derived-type-finalization.f90

 ! Test derived type finalization
 ! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s
 
 ! Missing tests:
 ! - finalization within BLOCK construct
 
 module derived_type_finalization
 
   type :: t1
     integer :: a
   contains
     final :: t1_final
+    final :: t1_final_1r
   end type
 
   type :: t2
     integer, allocatable, dimension(:) :: a
   contains
     final :: t2_final
   end type
 
   type :: t3
     type(t2) :: t
   end type
 
 contains
 
   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
 
   ! 7.5.6.3 point 1. Finalization of LHS.
   subroutine test_lhs()
     type(t1) :: lhs, rhs
     lhs = rhs
function no_func_ret_finalize() result(ty)
     type(t1) :: ty
     ty = t1(10)
   end function
 
 ! CHECK-LABEL: func.func @_QMderived_type_finalizationPno_func_ret_finalize() -> !fir.type<_QMderived_type_finalizationTt1{a:i32}> {
 ! 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
   use derived_type_finalization
   type(t1) :: t
   if (t%a == 10) return
   print *, 'end of program'
 end program