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 f00f0e11378cdac5949308b70524be8b880bb44b..3761b6589e81401c2764caed440699d5fd61b7c2 100644 (file)
--- 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 (file)
index 0000000..5acdecb
--- /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 (file)
index 0000000..9f3b4ca
--- /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 (file)
index 0000000..9631dad
--- /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