https://gcc.gnu.org/g:836f029d6a0ee0e6bd88605da994681498f5cf6a
commit r17-2025-g836f029d6a0ee0e6bd88605da994681498f5cf6a Author: Jerry DeLisle <[email protected]> Date: Mon Jun 29 08:36:06 2026 -0700 fortran: Fix finalizer list truncated when >= 3 finalizers match [PR121972] When gfc_resolve_finalizers copies matching finalizers from the template type into a derived type's finalizer list, a linked-list bug caused the third and later entries to be orphaned. Fix by using the standard tail-pointer idiom. PR fortran/121972 gcc/fortran/ChangeLog: * resolve.cc (gfc_resolve_finalizers): Fix linked-list tail-pointer bug that dropped all but the first two finalizers from a derived type's finalizer list when three or more matched. gcc/testsuite/ChangeLog: * gfortran.dg/pdt_70.f03: Add a matrix finalizer and update the check of the value of 'flag'. Diff: --- gcc/fortran/resolve.cc | 9 ++------- gcc/testsuite/gfortran.dg/pdt_70.f03 | 27 ++++++++++++++++++++++----- 2 files changed, 24 insertions(+), 12 deletions(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index f07c443b558a..12502f950b3e 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -16402,13 +16402,8 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) tmp = gfc_get_finalizer (); *tmp = *list; tmp->next = NULL; - if (*prev_link) - { - (*prev_link)->next = tmp; - prev_link = &tmp; - } - else - *prev_link = tmp; + *prev_link = tmp; + prev_link = &(tmp->next); list->proc_tree = gfc_find_sym_in_symtree (list->proc_sym); } } diff --git a/gcc/testsuite/gfortran.dg/pdt_70.f03 b/gcc/testsuite/gfortran.dg/pdt_70.f03 index 25801ed95494..0709dfbc7b30 100644 --- a/gcc/testsuite/gfortran.dg/pdt_70.f03 +++ b/gcc/testsuite/gfortran.dg/pdt_70.f03 @@ -3,6 +3,12 @@ ! PR104650 ! Contributed by Gerhard Steinmetz <[email protected]> ! +! Sometime later, after the original fix, it was noted that this test +! leaked memory. This was originally because subroutine finalize_t1m +! was unavailable. Adding it, resulted in the first in the FINAL list +! not being called. This has been retained and a dimension-3 variable +! 'e' added. +! module m1 type t1 integer :: i @@ -30,7 +36,7 @@ module m2 integer, kind :: k real(k), pointer :: vector(:) => NULL () contains - final :: finalize_t1s, finalize_t1v, finalize_t2e + final :: finalize_t1s, finalize_t1v, finalize_t1m, finalize_t2e end type integer :: flag = 0 @@ -51,6 +57,16 @@ contains end do end subroutine + impure subroutine finalize_t1m(x) + type(t(kind(0.0))) x(:,:) + do i = lbound(x,1), ubound(x,1) + do j = lbound(x,2), ubound(x,2) + if (associated(x(i,j)%vector)) deallocate(x(i,j)%vector) + flag = flag + 1 + end do + end do + end subroutine + impure elemental subroutine finalize_t2e(x) type(t(kind(0.0d0))), intent(inout) :: x if (associated(x%vector)) deallocate(x%vector) @@ -80,7 +96,7 @@ end module ! Test the standard example call example (dims) - if (flag /= 11 + dims**2) stop 2 + if (flag /= 11 + 2 * dims**2) stop 2 contains @@ -94,19 +110,20 @@ contains ! Returning from 'example' will effectively do ! call finalize_t1s(a) ! call finalize_t1v(b) +! call finalize_t1m(c) ! call finalize_t2e(d) -! No final subroutine will be called for variable C because the user +! No final subroutine will be called for variable e because the user ! omitted to define a suitable specific procedure for it. subroutine example(n) - type(t(kind(0.0))) a, b(10), c(n,2) + type(t(kind(0.0))) a, b(10), c(n,2), e(2,2,2) type(t(kind(0.0d0))) d(n,n) - real(kind(0.0)),target :: tgt(1) ! Explicit allocation to provide a valid memory refence for deallocation. call alloc_ts(a) call alloc_ts(b) call alloc_ts(c) call alloc_td(d) + call alloc_ts(e) end subroutine end
