diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
--- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -29,6 +29,7 @@
 namespace fir {
 class AbstractArrayBox;
 class ExtendedValue;
+class MutableBoxValue;
 class BoxValue;
 
 //===----------------------------------------------------------------------===//
@@ -573,7 +574,8 @@
 /// derived types (10.2.1.3 point 13).
 void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &lhs,
-                         const fir::ExtendedValue &rhs);
+                         const fir::ExtendedValue &rhs,
+                         bool needFinalization = false);
 
 /// Builds and returns the type of a ragged array header used to cache mask
 /// evaluations. RaggedArrayHeader is defined in
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2813,33 +2813,32 @@
               std::optional<fir::factory::MutableBoxReallocation> lhsRealloc;
               std::optional<fir::MutableBoxValue> lhsMutableBox;
 
-              // Finalize LHS on intrinsic assignment.
-              if (lhsType->IsPolymorphic() ||
-                  lhsType->IsUnlimitedPolymorphic() ||
-                  (isDerivedCategory(lhsType->category()) &&
-                   Fortran::semantics::IsFinalizable(
-                       lhsType->GetDerivedTypeSpec()))) {
-                if (lhsIsWholeAllocatable) {
-                  lhsMutableBox = genExprMutableBox(loc, assign.lhs);
-                  mlir::Value isAllocated =
-                      fir::factory::genIsAllocatedOrAssociatedTest(
-                          *builder, loc, *lhsMutableBox);
-                  builder->genIfThen(loc, isAllocated)
-                      .genThen([&]() {
-                        fir::runtime::genDerivedTypeDestroy(
-                            *builder, loc, fir::getBase(*lhsMutableBox));
-                      })
-                      .end();
-                } else {
-                  fir::ExtendedValue exv = genExprBox(loc, assign.lhs, stmtCtx);
-                  fir::runtime::genDerivedTypeDestroy(*builder, loc,
-                                                      fir::getBase(exv));
-                }
-              }
+              // Set flag to know if the LHS needs finalization. Polymorphic,
+              // unlimited polymorphic assignment will be done with genAssign.
+              // Assign runtime function performs the finalization.
+              bool needFinalization = !lhsType->IsPolymorphic() &&
+                                      !lhsType->IsUnlimitedPolymorphic() &&
+                                      (isDerivedCategory(lhsType->category()) &&
+                                       Fortran::semantics::IsFinalizable(
+                                           lhsType->GetDerivedTypeSpec()));
 
               auto lhs = [&]() -> fir::ExtendedValue {
                 if (lhsIsWholeAllocatable) {
                   lhsMutableBox = genExprMutableBox(loc, assign.lhs);
+                  // Finalize if needed.
+                  if (needFinalization) {
+                    mlir::Value isAllocated =
+                        fir::factory::genIsAllocatedOrAssociatedTest(
+                            *builder, loc, *lhsMutableBox);
+                    builder->genIfThen(loc, isAllocated)
+                        .genThen([&]() {
+                          fir::runtime::genDerivedTypeDestroy(
+                              *builder, loc, fir::getBase(*lhsMutableBox));
+                        })
+                        .end();
+                    needFinalization = false;
+                  }
+
                   llvm::SmallVector<mlir::Value> lengthParams;
                   if (const fir::CharBoxValue *charBox = rhs.getCharBox())
                     lengthParams.push_back(charBox->getLen());
@@ -2882,7 +2881,8 @@
               } else if (isDerivedCategory(lhsType->category())) {
                 // Fortran 2018 10.2.1.3 p13 and p14
                 // Recursively gen an assignment on each element pair.
-                fir::factory::genRecordAssignment(*builder, loc, lhs, rhs);
+                fir::factory::genRecordAssignment(*builder, loc, lhs, rhs,
+                                                  needFinalization);
               } else {
                 llvm_unreachable("unknown category");
               }
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -12,6 +12,7 @@
 #include "flang/Optimizer/Builder/Complex.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Runtime/Assign.h"
+#include "flang/Optimizer/Builder/Runtime/Derived.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
@@ -1205,7 +1206,8 @@
 void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
                                        mlir::Location loc,
                                        const fir::ExtendedValue &lhs,
-                                       const fir::ExtendedValue &rhs) {
+                                       const fir::ExtendedValue &rhs,
+                                       bool needFinalization) {
   assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
   auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
   assert(baseTy && "must be a memory type");
@@ -1229,6 +1231,13 @@
     fir::runtime::genAssign(builder, loc, toMutableBox, from);
     return;
   }
+
+  // Finalize LHS on intrinsic assignment.
+  if (needFinalization) {
+    mlir::Value box = builder.createBox(loc, lhs);
+    fir::runtime::genDerivedTypeDestroy(builder, loc, box);
+  }
+
   // Otherwise, the derived type has compile time constant size and for which
   // the component by component assignment can be replaced by a memory copy.
   // Since we do not know the size of the derived type in lowering, do a
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
@@ -12,12 +12,26 @@
     final :: t1_final
   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 t2_final(this)
+    type(t2) :: this
+  end subroutine
+
   ! 7.5.6.3 point 1. Finalization of LHS.
   subroutine test_lhs()
     type(t1) :: lhs, rhs
@@ -168,6 +182,27 @@
 ! CHECK: %{{.*}} = fir.call @_FortranAioEndIoStatement
 ! CHECK: return
 
+  subroutine test_avoid_double_finalization(a)
+    type(t3), intent(inout) :: a
+    type(t3)                :: b
+    b = a
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_avoid_double_finalization(
+! CHECK: fir.call @_FortranAInitialize(
+! CHECK-NOT: %{{.*}} = fir.call @_FortranADestroy
+! CHECK: %{{.*}} = fir.call @_FortranAAssign(
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(
+
+  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}>
+
 end module
 
 program p