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 @@ -613,7 +613,9 @@ 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 --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -1137,6 +1137,7 @@ 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 @@ helper.createAssign(fir::ExtendedValue{*toChar}, fir::ExtendedValue{*fromChar}); } else if (type.isa()) { - 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 @@ 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 --- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp +++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp @@ -153,11 +153,18 @@ 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::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 --- a/flang/test/HLFIR/assign-codegen.fir +++ b/flang/test/HLFIR/assign-codegen.fir @@ -335,3 +335,38 @@ // CHECK: %[[VAL_13:.*]] = fir.call @_FortranAAssignTemporary(%[[VAL_10]], %[[VAL_11]], %[[VAL_12]], %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, 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.bindc_name = "s1"}, %arg1: !fir.ref> {fir.bindc_name = "s2"}) { + %0:2 = hlfir.declare %arg0 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs1"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %1:2 = hlfir.declare %arg1 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs2"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + hlfir.assign %1#0 to %0#0 : !fir.ref>, !fir.ref> + return +} +// CHECK-LABEL: func.func @_QFPtest_scalar_lhs_finalization( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "s1"}, +// CHECK-SAME: %[[VAL_1:.*]]: !fir.ref> {fir.bindc_name = "s2"}) { +// CHECK: %[[VAL_2:.*]] = fir.declare %[[VAL_0]] {uniq_name = "_QFFtest_scalar_lhs_finalizationEs1"} : (!fir.ref>) -> !fir.ref> +// CHECK: %[[VAL_3:.*]] = fir.declare %[[VAL_1]] {uniq_name = "_QFFtest_scalar_lhs_finalizationEs2"} : (!fir.ref>) -> !fir.ref> +// CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_2]] : (!fir.ref>) -> !fir.box> +// CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.box>) -> !fir.box +// CHECK: %[[VAL_6:.*]] = fir.call @_FortranADestroy(%[[VAL_5]]) : (!fir.box) -> 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.field) -> !fir.ref +// 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.field) -> !fir.ref +// CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_8]] : !fir.ref +// CHECK: fir.store %[[VAL_11]] to %[[VAL_10]] : !fir.ref +// CHECK: return +// CHECK: } + +// Check that Destroy() is not called for temporary LHS. +func.func @_QFPtest_scalar_temp_lhs_no_finalization(%arg0: !fir.ref> {fir.bindc_name = "s1"}, %arg1: !fir.ref> {fir.bindc_name = "s2"}) { + %0:2 = hlfir.declare %arg0 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs1"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %1:2 = hlfir.declare %arg1 {uniq_name = "_QFFtest_scalar_lhs_finalizationEs2"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + hlfir.assign %1#0 to %0#0 temporary_lhs : !fir.ref>, !fir.ref> + return +} +// CHECK-LABEL: func.func @_QFPtest_scalar_temp_lhs_no_finalization( +// CHECK-NOT: fir.call @_FortranADestroy