https://gcc.gnu.org/g:bb873ada17b5cea56e7ac4c4156af2f07e8db2cf

commit r17-1767-gbb873ada17b5cea56e7ac4c4156af2f07e8db2cf
Author: Paul Thomas <[email protected]>
Date:   Tue Jun 23 10:21:47 2026 +0100

    Fortran: Fix memory leaks in PDT tests. [PR121972]
    
    2026-06-22  Paul Thomas  <[email protected]>
    
    gcc/fortran
            PR fortran/121972
            * decl.cc (build_struct): Convert the PDT template before the
            call to gfc_build_class_symbol.
    
    gcc/testsuite/
            PR fortran/121972
            * gfortran.dg/pdt_77.f03: Add 'finalalize_navier_stokes', which
            tests that the 'navier_stokes' component 'p' is pointed to the
            correct vtable in both tests. Check that VIEW_CONVERT_EXPR does
            not appear in the tree dump.

Diff:
---
 gcc/fortran/decl.cc                  | 18 ++++++++++++++++++
 gcc/testsuite/gfortran.dg/pdt_77.f03 | 18 ++++++++++++++++--
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 9c124cb103d2..63941edebd9a 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -2546,6 +2546,24 @@ build_struct (const char *name, gfc_charlen *cl, 
gfc_expr **init,
 
   gfc_apply_init (&c->ts, &c->attr, c->initializer);
 
+  /* Convert a class, PDT component of a non-derived type to a specific 
instance
+     before gfc_build_class_symbol gets to work on it.  */
+  if (c->ts.type == BT_CLASS
+      && !(gfc_current_block ()->attr.pdt_template
+          || gfc_current_block ()->attr.pdt_type)
+      && c->ts.u.derived->attr.pdt_template)
+    {
+      match m = gfc_get_pdt_instance (decl_type_param_list, &c->ts.u.derived, 
NULL);
+      if (m != MATCH_YES)
+       {
+         if (!gfc_error_check ())
+           gfc_error ("Parameterized component of a non-parameterized "
+                      "derived type at %C could not be converted to a valid "
+                      "instance");
+         return false;
+       }
+    }
+
   /* Check array components.  */
   if (!c->attr.dimension)
     goto scalar;
diff --git a/gcc/testsuite/gfortran.dg/pdt_77.f03 
b/gcc/testsuite/gfortran.dg/pdt_77.f03
index 627c0f0de807..f24e7fc49f05 100644
--- a/gcc/testsuite/gfortran.dg/pdt_77.f03
+++ b/gcc/testsuite/gfortran.dg/pdt_77.f03
@@ -1,6 +1,12 @@
 ! { dg-do run }
+! { dg-options "-fdump-tree-original" }
 !
 ! Test the fix for PR110012, which failed to compile with an ICE.
+! Later, it was found that mfe_disc_test was leaking memory because
+! the 'navier_stokes' component p was given the PDT template dynamic
+! type, rather than that of the correct instance. This is detected
+! by the added, final subroutine being called twice, rather than
+! once (PR121972).
 !
 ! Contributed by Neil Carlson  <[email protected]>
 !
@@ -14,7 +20,10 @@ module navier_stokes_type
   use pde_class
   type, extends(pde) :: navier_stokes
     integer, allocatable :: data_(:)
+  contains
+    final :: finalIze_navier_stokes
   end type
+  integer :: ctr = 0
 contains
   subroutine alloc_navier_stokes(p , n)
     class(pde(:)), allocatable :: p
@@ -25,6 +34,10 @@ contains
         p%data_ = [(i, i = 1, p%npde)]
     end select
   end subroutine
+  impure elemental subroutine finalIze_navier_stokes (self)
+    type(navier_stokes), intent(inout) :: self
+    ctr = ctr + 1
+  end
 end module
 
 module mfe_disc_type
@@ -35,11 +48,12 @@ module mfe_disc_type
 end module
 
 program test
+  use navier_stokes_type
   call navier_stokes_test
   call mfe_disc_test
+  if (ctr /= 2) stop 3
 contains
   subroutine navier_stokes_test
-    use navier_stokes_type
     class (pde(:)), allocatable :: x
     call alloc_navier_stokes (x, 4)
     select type (x)
@@ -49,7 +63,6 @@ contains
   end subroutine
 
   subroutine mfe_disc_test
-    use navier_stokes_type
     use mfe_disc_type
     type (foo), allocatable :: x
     allocate (x)
@@ -61,3 +74,4 @@ contains
     if (allocated (x) .and. allocated (x%p)) deallocate (x%p)
   end subroutine
 end program
+! { dg-final { scan-tree-dump-times "VIEW_CONVERT_EXPR" 0 "original" } }

Reply via email to