diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp index a14f3106a7232..e9d18a054e35a 100644 --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -1261,6 +1261,15 @@ static bool recordTypeCanBeMemCopied(fir::RecordType recordType) { return true; } +static bool mayHaveFinalizer(fir::RecordType recordType, + fir::FirOpBuilder &builder) { + if (auto typeInfo = builder.getModule().lookupSymbol( + recordType.getName())) + return !typeInfo.getNoFinal(); + // No info, be pessimistic. + return true; +} + void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc, const fir::ExtendedValue &lhs, @@ -1277,7 +1286,8 @@ void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder, fir::getBase(rhs).getType().isa(); auto recTy = baseTy.dyn_cast(); assert(recTy && "must be a record type"); - if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) { + if ((needFinalization && mayHaveFinalizer(recTy, builder)) || + hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) { auto to = fir::getBase(builder.createBox(loc, lhs)); auto from = fir::getBase(builder.createBox(loc, rhs)); // The runtime entry point may modify the LHS descriptor if it is @@ -1294,12 +1304,6 @@ void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder, 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/HLFIR/assign-codegen-derived.fir b/flang/test/HLFIR/assign-codegen-derived.fir new file mode 100644 index 0000000000000..c45c118ed46c5 --- /dev/null +++ b/flang/test/HLFIR/assign-codegen-derived.fir @@ -0,0 +1,29 @@ +// Test hlfir.assign code generation to FIR of derived type requiring +// or not finalization. + +// RUN: fir-opt %s -convert-hlfir-to-fir | FileCheck %s + +!t_simple = !fir.type +fir.type_info @simple noinit nodestroy nofinal : !t_simple + +func.func @test_simple(%a: !fir.ref, %b: !fir.ref) { + hlfir.assign %b to %a : !fir.ref, !fir.ref + return +} +// CHECK-LABEL: func.func @test_simple( +// CHECK-NOT: Destroy +// CHECK: %[[VAL_1:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref>, !fir.field) -> !fir.ref +// CHECK: %[[VAL_3:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref>, !fir.field) -> !fir.ref +// CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]] : !fir.ref +// CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref + + +!t_with_final = !fir.type +fir.type_info @with_final noinit : !t_with_final + +func.func @test_with_final(%a: !fir.ref, %b: !fir.ref) { + hlfir.assign %b to %a : !fir.ref, !fir.ref + return +} +// CHECK-LABEL: func.func @test_with_final( +// CHECK: fir.call @_FortranAAssign diff --git a/flang/test/HLFIR/assign-codegen.fir b/flang/test/HLFIR/assign-codegen.fir index 5474ef5393df4..2211676eac580 100644 --- a/flang/test/HLFIR/assign-codegen.fir +++ b/flang/test/HLFIR/assign-codegen.fir @@ -347,21 +347,21 @@ func.func @_QFPtest_scalar_lhs_finalization(%arg0: !fir.ref> {fir.bindc_name = "s1"}, // CHECK-SAME: %[[VAL_1:.*]]: !fir.ref> {fir.bindc_name = "s2"}) { +// CHECK: %[[BOX:.*]] = fir.alloca !fir.box> // 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: %[[VAL_5:.*]] = fir.embox %[[VAL_3]] : (!fir.ref>) -> !fir.box> +// CHECK: fir.store %[[VAL_4]] to %[[BOX]] : !fir.ref>> +// CHECK: %[[VAL_10:.*]] = fir.convert %[[BOX]] : (!fir.ref>>) -> !fir.ref> +// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_5]] : (!fir.box>) -> !fir.box +// CHECK: %[[VAL_12:.*]] = fir.convert %{{.*}} : (!fir.ref>) -> !fir.ref +// CHECK: %[[VAL_13:.*]] = fir.call @_FortranAAssign(%[[VAL_10]], %[[VAL_11]], %[[VAL_12]], %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none // CHECK: return // CHECK: } -// Check that Destroy() is not called for temporary LHS. +// Check that Assign() or 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>) @@ -369,6 +369,7 @@ func.func @_QFPtest_scalar_temp_lhs_no_finalization(%arg0: !fir.ref> {fir.bindc_name = "y"}) { diff --git a/flang/test/Lower/derived-type-finalization.f90 b/flang/test/Lower/derived-type-finalization.f90 index d0fbfe8906c4d..86e2e274e9d7e 100644 --- a/flang/test/Lower/derived-type-finalization.f90 +++ b/flang/test/Lower/derived-type-finalization.f90 @@ -55,11 +55,12 @@ subroutine test_lhs_allocatable() end subroutine ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs() { +! CHECK: %[[BOXREF:.*]] = fir.alloca !fir.box> ! CHECK: %[[LHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "lhs", uniq_name = "_QMderived_type_finalizationFtest_lhsElhs"} -! CHECK: %[[RHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "rhs", uniq_name = "_QMderived_type_finalizationFtest_lhsErhs"} ! CHECK: %[[EMBOX:.*]] = fir.embox %[[LHS]] : (!fir.ref>) -> !fir.box> -! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box>) -> !fir.box -! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box) -> none +! CHECK: fir.store %[[EMBOX]] to %[[BOXREF]] : !fir.ref>> +! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOXREF]] : (!fir.ref>>) -> !fir.ref> +! CHECK: %{{.*}} = fir.call @_FortranAAssign(%[[BOX_NONE]], {{.*}} ! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs_allocatable() { ! CHECK: %[[LHS:.*]] = fir.alloca !fir.box>> {bindc_name = "lhs", uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableElhs"} @@ -210,7 +211,8 @@ function no_func_ret_finalize() result(ty) end function ! CHECK-LABEL: func.func @_QMderived_type_finalizationPno_func_ret_finalize() -> !fir.type<_QMderived_type_finalizationTt1{a:i32}> { -! CHECK: %{{.*}} = fir.call @_FortranADestroy +! CHECK: %{{.*}} = fir.call @_FortranAAssign +! CHECK-NOT: fir.call @_FortranADestroy ! CHECK: return %{{.*}} : !fir.type<_QMderived_type_finalizationTt1{a:i32}> function copy(a) result(ty)