The attached patch and ChangeLog (from git show).The patch was provided from Andrew Benson and I combined this with the test case that Christopher Albert provided in the PR.
Regression tested on x86_64_linux_gnu. OK for mainline? Regards, Jerry
commit 6fb647bc5a5bbabd36c3b067080c33802a4e15db Author: Jerry DeLisle <[email protected]> Date: Sat Dec 20 13:16:13 2025 -0800 fortran: [PR121475] Function result not finalized. PR fortran/121475 gcc/fortran/ChangeLog: * trans.cc (gfc_finalize_tree_expr): Add logic to allow the function result to be resolved in resolve.cc (generate_component_assignments). gcc/testsuite/ChangeLog: * gfortran.dg/pr121475.f90: New test as posted in the PR from Christopher Albert Signed-off-by: Andrew Benson <[email protected]> diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 47396c3cbab..dcacf94e413 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1623,7 +1623,10 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived, if (derived && (derived->attr.is_c_interop || derived->attr.is_iso_c || derived->attr.is_bind_c - || derived->attr.defined_assign_comp)) + || (derived->attr.extension && derived->f2k_derived + && derived->f2k_derived->tb_op[INTRINSIC_ASSIGN]) + || (!derived->attr.extension + && derived->attr.defined_assign_comp))) return; if (is_class) diff --git a/gcc/testsuite/gfortran.dg/pr121475.f90 b/gcc/testsuite/gfortran.dg/pr121475.f90 new file mode 100644 index 00000000000..ab3a8c0b0e6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr121475.f90 @@ -0,0 +1,75 @@ +! { dg-do run } +! +! PR fortran/121475 - Function result not finalized when passed to +! user-defined assignment. +! +! F2003 4.5.5.2 requires that function results be finalized after +! execution of the innermost executable construct. When the function +! result is passed to a user-defined assignment, the finalization was +! being skipped because of early return for types with defined_assign_comp. + +! Test case put together by Christopher Albert. + +module m + implicit none + integer :: final_count = 0 + + type :: base + contains + procedure :: assign + generic :: assignment(=) => assign + end type + + type, extends(base) :: derived + integer :: val + contains + final :: finalize + end type + + interface derived + module procedure constructor + end interface + +contains + + subroutine finalize(self) + type(derived), intent(inout) :: self + final_count = final_count + 1 + end subroutine + + function constructor() result(self) + type(derived) :: self + self%val = 0 + end function + + subroutine assign(to, from) + class(base), intent(out) :: to + class(base), intent(in) :: from + select type (to) + type is (derived) + select type (from) + type is (derived) + to%val = from%val + end select + end select + end subroutine + +end module + +program test + use m + implicit none + + block + type(derived) :: obj + + final_count = 0 + obj = derived() + + ! Function result and intermediate temporaries finalized + if (final_count /= 2) stop 1 + end block + + ! obj goes out of scope, finalized again + if (final_count /= 3) stop 2 +end program
