I will commit the attached patch approved by Paul on MatterMost. This fixes a
memory leak found in the PDT_70 test case.
Regression tested on x86_64
Thanks for review Paul.
Regards,
Jerry
---
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'.
---From cff889aa9f1ffcfce367bbed29fd9004b2567b93 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 29 Jun 2026 08:36:06 -0700
Subject: [PATCH] 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'.
---
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 d479b6a80e5..9a820c179f5 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 25801ed9549..0709dfbc7b3 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
--
2.54.0
