https://gcc.gnu.org/g:c8ea9199ba0a65eb591557632f86a249e3a3f117
commit r16-8958-gc8ea9199ba0a65eb591557632f86a249e3a3f117 Author: Paul Thomas <[email protected]> Date: Sat May 23 14:40:19 2026 +0100 Fortran: Fix ICE in allocatable finalization expression [PR125391] 2026-05-23 Paul Thomas <[email protected]> gcc/fortran PR fortran/125391 * trans.cc (gfc_assignment_finalizer_call): For finalization of allocatable and pointer lhs before assignment, gfc_conv_expr should be used with se.descriptor_only. This avoids implicit of set_factored_descriptor_value by gfc_conv_expr_descriptor. gcc/testsuite/ PR fortran/125391 * gfortran.dg/pr125391.f90: New test. (cherry picked from commit c9f26edda05b045d98c87d8c5dc0163f2cd0b652) Diff: --- gcc/fortran/trans.cc | 5 +- gcc/testsuite/gfortran.dg/pr125391.f90 | 83 ++++++++++++++++++++++++++++++++++ 2 files changed, 87 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 1d7006a69630..c366d7f4dbff 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1570,7 +1570,10 @@ gfc_assignment_finalizer_call (gfc_se *lse, gfc_expr *expr1, bool init_flag) gfc_init_se (&se, NULL); if (expr1->rank) { - gfc_conv_expr_descriptor (&se, expr1); + /* Avoid calling trans-array.cc(set_factored_descriptor_value) by + not using gfc_conv_expr_descriptor. */ + se.descriptor_only = 1; + gfc_conv_expr (&se, expr1); ptr = gfc_conv_descriptor_data_get (se.expr); } else diff --git a/gcc/testsuite/gfortran.dg/pr125391.f90 b/gcc/testsuite/gfortran.dg/pr125391.f90 new file mode 100644 index 000000000000..5966a3cff161 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr125391.f90 @@ -0,0 +1,83 @@ +! { dg-do run } +! +! Fix for PR125391 due to : +! gfortran ICE: in gimplify_var_or_parm_decl, at gimplify.cc:3416 (26.2) +! in gimplify_var_or_parm_decl, at gimplify.cc:3166 (trunk, 16/5/10) +! +! +! Contributed by Federico Perini <[email protected]> +! +module m + implicit none + type :: inner + integer :: x = 0 + contains + final :: inner_final + end type + + type :: outer2 + type(inner) :: items(1) + end type + + type :: outer1 + type(inner), allocatable :: items(:) + end type + + integer :: ctr = 0 + +contains + impure elemental subroutine inner_final(this) + type(inner), intent(inout) :: this + ctr = ctr + 1 + end subroutine + + + ! Variant A: whole-array component assignment. + subroutine copy_whole1(lhs, rhs) + class(outer1), intent(inout) :: lhs + type(outer1), intent(in) :: rhs + lhs%items = rhs%items ! ICE! + end subroutine + + ! Variant B: assignment from an array constructor. + subroutine make_singleton1(lhs, x) + class(outer1), intent(inout) :: lhs + type(inner), intent(in) :: x + lhs%items = [x] ! ICE! + end subroutine + + ! Variant A: whole-array component assignment. + subroutine copy_whole2(lhs, rhs) + class(outer2), intent(inout) :: lhs + type(outer2), intent(in) :: rhs + lhs%items = rhs%items + end subroutine + + ! Variant B: assignment from an array constructor. + subroutine make_singleton2(lhs, x) + class(outer2), intent(inout) :: lhs + type(inner), intent(in) :: x + lhs%items = [x] + end subroutine +end module + +program p + use m + type(outer1) :: x + type(outer2) :: y + + ! Verify that the original problem is fixed + x%items = [inner(2)] + if (ctr /= 0) stop 1 ! x%items not allocated + call make_singleton1 (x, inner(42)) + call copy_whole1 (x, outer1([inner(S)])) + if (ctr /= 2) stop 2 ! one finalization for each call + + ! Verify that the fix has not broken non-allocatable component references + y%items = [inner(2)] ! y%items finalized before assignment + if (ctr /= 3) stop 3 + call make_singleton2 (y, inner(42)) + call copy_whole2 (y, outer2([inner(42)])) + if (ctr /= 5) stop 4 ! one finalization for each call + +end program
