[flang][hlfir] Fixed finalization in hlfir.assign codegen.

When hlfir.assign is lowered into simple load/store,
we may still need to finalize the LHS.
The patch passes `needFinalization` to `genScalarAssignment`
for LHS of any derived type, so some `Destroy` calls
might be redundant. They can be removed later by propagating/deducing
IsFinalizable information about the LHS type.

Reviewed By: clementval

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

4 files changed, 53 insertions, 3 deletions

diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
index 943e313..451d0f1 100644
--- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -613,7 +613,9 @@ fir::ExtendedValue arraySectionElementToExtendedValue(
 void genScalarAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &lhs,
                          const fir::ExtendedValue &rhs,
+                         bool needFinalization = false,
                          bool isTemporaryLHS = false);
+
 /// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalar derived
 /// types. The assignment follows Fortran intrinsic assignment semantic for
 /// derived types (10.2.1.3 point 13).
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index fe23e13..c43245d 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -1137,6 +1137,7 @@ void fir::factory::genScalarAssignment(fir::FirOpBuilder &builder,
                                        mlir::Location loc,
                                        const fir::ExtendedValue &lhs,
                                        const fir::ExtendedValue &rhs,
+                                       bool needFinalization,
                                        bool isTemporaryLHS) {
   assert(lhs.rank() == 0 && rhs.rank() == 0 && "must be scalars");
   auto type = fir::unwrapSequenceType(
@@ -1149,8 +1150,8 @@ void fir::factory::genScalarAssignment(fir::FirOpBuilder &builder,
     helper.createAssign(fir::ExtendedValue{*toChar},
                         fir::ExtendedValue{*fromChar});
   } else if (type.isa<fir::RecordType>()) {
-    fir::factory::genRecordAssignment(
-        builder, loc, lhs, rhs, /*needFinalization=*/false, isTemporaryLHS);
+    fir::factory::genRecordAssignment(builder, loc, lhs, rhs, needFinalization,
+                                      isTemporaryLHS);
   } else {
     assert(!fir::hasDynamicSize(type));
     auto rhsVal = fir::getBase(rhs);
@@ -1230,7 +1231,12 @@ static void genComponentByComponentAssignment(fir::FirOpBuilder &builder,
       auto from =
           fir::factory::componentToExtendedValue(builder, loc, fromCoor);
       auto to = fir::factory::componentToExtendedValue(builder, loc, toCoor);
-      fir::factory::genScalarAssignment(builder, loc, to, from, isTemporaryLHS);
+      // If LHS finalization is needed it is expected to be done
+      // for the parent record, so that component-by-component
+      // assignments may avoid finalization calls.
+      fir::factory::genScalarAssignment(builder, loc, to, from,
+                                        /*needFinalization=*/false,
+                                        isTemporaryLHS);
     }
     if (outerLoop)
       builder.setInsertionPointAfter(*outerLoop);
diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
index e6f132c..aa893e4 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
@@ -153,11 +153,18 @@ public:
       else
         fir::runtime::genAssign(builder, loc, toMutableBox, from);
     } else {
+      // TODO: use the type specification to see if IsFinalizable is set,
+      // or propagate IsFinalizable attribute from lowering.
+      bool needFinalization =
+          !assignOp.isTemporaryLHS() &&
+          mlir::isa<fir::RecordType>(fir::getElementTypeOf(lhsExv));
+
       // genScalarAssignment() must take care of potential overlap
       // between LHS and RHS. Note that the overlap is possible
       // also for components of LHS/RHS, and the Assign() runtime
       // must take care of it.
       fir::factory::genScalarAssignment(builder, loc, lhsExv, rhsExv,
+                                        needFinalization,
                                         assignOp.isTemporaryLHS());
     }
     rewriter.eraseOp(assignOp);
diff --git a/flang/test/HLFIR/assign-codegen.fir b/flang/test/HLFIR/assign-codegen.fir
index c5473b0..29d002b 100644
--- a/flang/test/HLFIR/assign-codegen.fir
+++ b/flang/test/HLFIR/assign-codegen.fir
@@ -335,3 +335,38 @@ func.func @test_allocatable_component_temp(%arg0: !fir.ref<!fir.type<_QFtestTt1{
 // CHECK:           %[[VAL_13:.*]] = fir.call @_FortranAAssignTemporary(%[[VAL_10]], %[[VAL_11]], %[[VAL_12]], %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
 // CHECK:           return
 // CHECK:         }
+
+// Check that Destroy() is called for LHS, when hlfir.assign
+// is lowered into simple load/store.
+func.func @_QFPtest_scalar_lhs_finalization(%arg0: !fir.ref<!fir.type<_QMa8vTt1{val:i32}>> {fir.bindc_name = "s1"}, %arg1: !fir.ref<!fir.type<_QMa8vTt1{val:i32}>> {fir.bindc_name = "s2"}) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs1"} : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>) -> (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>)
+  %1:2 = hlfir.declare %arg1 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs2"} : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>) -> (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>)
+  hlfir.assign %1#0 to %0#0 : !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>
+  return
+}
+// CHECK-LABEL:   func.func @_QFPtest_scalar_lhs_finalization(
+// CHECK-SAME:                                                %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMa8vTt1{val:i32}>> {fir.bindc_name = "s1"},
+// CHECK-SAME:                                                %[[VAL_1:.*]]: !fir.ref<!fir.type<_QMa8vTt1{val:i32}>> {fir.bindc_name = "s2"}) {
+// CHECK:           %[[VAL_2:.*]] = fir.declare %[[VAL_0]] {uniq_name = "_QFFtest_scalar_lhs_finalizationEs1"} : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>) -> !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>
+// CHECK:           %[[VAL_3:.*]] = fir.declare %[[VAL_1]] {uniq_name = "_QFFtest_scalar_lhs_finalizationEs2"} : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>) -> !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>
+// CHECK:           %[[VAL_4:.*]] = fir.embox %[[VAL_2]] : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>) -> !fir.box<!fir.type<_QMa8vTt1{val:i32}>>
+// CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.type<_QMa8vTt1{val:i32}>>) -> !fir.box<none>
+// CHECK:           %[[VAL_6:.*]] = fir.call @_FortranADestroy(%[[VAL_5]]) : (!fir.box<none>) -> none
+// CHECK:           %[[VAL_7:.*]] = fir.field_index val, !fir.type<_QMa8vTt1{val:i32}>
+// CHECK:           %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_7]] : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.field) -> !fir.ref<i32>
+// CHECK:           %[[VAL_9:.*]] = fir.field_index val, !fir.type<_QMa8vTt1{val:i32}>
+// CHECK:           %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_9]] : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.field) -> !fir.ref<i32>
+// CHECK:           %[[VAL_11:.*]] = fir.load %[[VAL_8]] : !fir.ref<i32>
+// CHECK:           fir.store %[[VAL_11]] to %[[VAL_10]] : !fir.ref<i32>
+// CHECK:           return
+// CHECK:         }
+
+// Check that Destroy() is not called for temporary LHS.
+func.func @_QFPtest_scalar_temp_lhs_no_finalization(%arg0: !fir.ref<!fir.type<_QMa8vTt1{val:i32}>> {fir.bindc_name = "s1"}, %arg1: !fir.ref<!fir.type<_QMa8vTt1{val:i32}>> {fir.bindc_name = "s2"}) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs1"} : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>) -> (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>)
+  %1:2 = hlfir.declare %arg1 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs2"} : (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>) -> (!fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>)
+  hlfir.assign %1#0 to %0#0 temporary_lhs : !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>, !fir.ref<!fir.type<_QMa8vTt1{val:i32}>>
+  return
+}
+// CHECK-LABEL:   func.func @_QFPtest_scalar_temp_lhs_no_finalization(
+// CHECK-NOT: fir.call @_FortranADestroy