From: Paul Thomas <pault@gcc.gnu.org>
Date: Fri, 3 Oct 2025 06:29:50 +0000 (+0100)
Subject: Fortran: Error in nested PDTs with undefined KIND exprs. [122109]
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=e4e6a42ae93a6a721de4d9d09be1fee6cea7fa09;p=thirdparty%2Fgcc.git

Fortran: Error in nested PDTs with undefined KIND exprs. [122109]

2025-10-03  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/122089
	* decl.cc (gfc_get_pdt_instance): If gfc_extract_int is true an
	error has occurred because the kind expr was not provided. Use
	the template in this case and return MATCH_YES.

gcc/testsuite/
	PR fortran/122089
	* gfortran.dg/pdt_52.f03: New test.
	* gfortran.dg/pdt_53.f03: New test.
	* gfortran.dg/pdt_54.f03: New test.
---

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index f00f0e11378..3761b6589e8 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4038,7 +4038,15 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 	}
 
       kind_value = 0;
-      gfc_extract_int (kind_expr, &kind_value);
+      /* This can come about during the parsing of nested pdt_templates. An
+	 error arises because the KIND parameter expression has not been
+	 provided. Use the template instead of an incorrect instance.  */
+      if (gfc_extract_int (kind_expr, &kind_value))
+	{
+	  gfc_free_actual_arglist (type_param_spec_list);
+	  return MATCH_YES;
+	}
+
       sprintf (name + strlen (name), "_%d", kind_value);
 
       if (!name_seen && actual_param)
diff --git a/gcc/testsuite/gfortran.dg/pdt_52.f03 b/gcc/testsuite/gfortran.dg/pdt_52.f03
new file mode 100644
index 00000000000..5acdecbdf3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_52.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! Test the fix for PR122089 in which an error occured in compiling the module
+! because a spurious REAL(KIND=0) was being produced for 'values_'.
+!
+! Other failures are indicated by the comments. For reasons that are not to me,
+! they didn't fail when combined with this test.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensor_m
+  implicit none
+
+  type tensor_t(k)
+    integer, kind :: k = kind(1.)
+    real(k), allocatable :: values_               ! ICE if not allocatable
+  end type
+
+  type input_output_pair_t(k)
+    integer, kind :: k
+    type(tensor_t(k)) inputs_, expected_outputs_  ! ICE if 2nd component dropped
+  end type
+
+  type mini_batch_t(k)
+    integer, kind :: k
+    type(input_output_pair_t(k)) input_output_pairs_
+  end type
+
+end module tensor_m
+
+  use tensor_m
+  type (mini_batch_t(k = kind(1d0))) :: x
+  allocate (x%input_output_pairs_%inputs_%values_, source = 42d0)
+  print *, kind (x%input_output_pairs_%inputs_%values_), x%input_output_pairs_%inputs_%values_
+  deallocate (x%input_output_pairs_%inputs_%values_)
+end
diff --git a/gcc/testsuite/gfortran.dg/pdt_53.f03 b/gcc/testsuite/gfortran.dg/pdt_53.f03
new file mode 100644
index 00000000000..9f3b4ca82ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_53.f03
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! Test the fix for PR122089 in which an error occured in compiling the module
+! because a spurious REAL(KIND=0) was being produced for 'values_'.
+!
+! This is a variant of pdt_52.f03. See the comments in that test.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensor_m
+  implicit none
+
+  type tensor_t(k)
+    integer, kind :: k = kind(1.)
+    real(k) :: values_                            ! Used to ICE
+  end type
+
+  type input_output_pair_t(k)
+    integer, kind :: k
+    type(tensor_t(k)) inputs_, expected_outputs_
+  end type
+
+  type mini_batch_t(k)
+    integer, kind :: k
+    type(input_output_pair_t(k)) input_output_pairs_
+  end type
+
+end module tensor_m
diff --git a/gcc/testsuite/gfortran.dg/pdt_54.f03 b/gcc/testsuite/gfortran.dg/pdt_54.f03
new file mode 100644
index 00000000000..9631dad2f5e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_54.f03
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! Test the fix for PR122089 in which an error occured in compiling the module
+! because a spurious REAL(KIND=0) was being produced for 'values_'.
+!
+! This is a variant of pdt_52.f03. See the comments in that test.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensor_m
+  implicit none
+
+  type tensor_t(k)
+    integer, kind :: k = kind(1.)
+    real(k), allocatable :: values_
+  end type
+
+  type input_output_pair_t(k)
+    integer, kind :: k
+    type(tensor_t(k)) inputs_     ! Used to ICE if 2nd component dropped
+  end type
+
+  type mini_batch_t(k)
+    integer, kind :: k
+    type(input_output_pair_t(k)) input_output_pairs_
+  end type
+
+end module tensor_m