diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -415,6 +415,7 @@
     // 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::runtime::genDerivedTypeDestroy(*bldr, loc,
                                               fir::getBase(*allocatedResult));
         });
+        cleanupWithDestroy = true;
       } else {
         const Fortran::semantics::DerivedTypeSpec &typeSpec =
             retTy->GetDerivedTypeSpec();
@@ -433,12 +435,13 @@
             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
--- a/flang/test/Lower/derived-type-finalization.f90
+++ b/flang/test/Lower/derived-type-finalization.f90
@@ -10,6 +10,7 @@
     integer :: a
   contains
     final :: t1_final
+    final :: t1_final_1r
   end type
 
   type :: t2
@@ -28,6 +29,10 @@
     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 @@
 ! 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