Fortran: Fix memory leaks in PDT tests. [PR121972]

2026-06-22  Paul Thomas  <pault@gcc.gnu.org>

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 --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 9c124cb103d23b0bfb9592ae716a512bc9174ecf..63941edebd9a6cb625ef7675f438c4887c69e1f3 100644 (file)
--- 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 627c0f0de807724e85a1207706650ba3dfbc72a4..f24e7fc49f055097588aaa8ae617675b89d11d33 100644 (file)
--- 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  <neil.n.carlson@gmail.com>
 !
@@ -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" } }