Fortran: [PDT] Failure with local allocatable PDT array [PR122693]

2025-12-06  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/122693
	* array.cc (gfc_match_array_constructor): Stash and restore
	gfc_current_ns after the call to 'gfc_match_type_spec'.

gcc/testsuite
	PR fortran/122693
	* gfortran.dg/pdt_75.f03: New test.

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 359d743a632fc7a11fe654c74c59ae9d611441a5..471f0cb9f3abe67b2b5011c5f7e061c30a56f41e 100644 (file)
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -1344,6 +1344,7 @@ gfc_match_array_constructor (gfc_expr **result)
   match m;
   const char *end_delim;
   bool seen_ts;
+  gfc_namespace *old_ns = gfc_current_ns;
 
   head = NULL;
   seen_ts = false;
@@ -1368,6 +1369,8 @@ gfc_match_array_constructor (gfc_expr **result)
   /* Try to match an optional "type-spec ::"  */
   gfc_clear_ts (&ts);
   m = gfc_match_type_spec (&ts);
+  gfc_current_ns = old_ns;
+
   if (m == MATCH_YES)
     {
       seen_ts = (gfc_match (" ::") == MATCH_YES);

diff --git a/gcc/testsuite/gfortran.dg/pdt_75.f03 b/gcc/testsuite/gfortran.dg/pdt_75.f03
new file mode 100644 (file)
index 0000000..f700871
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_75.f03
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! Tests the fix for pr122693, which failed in compilation with the errors
+! shown below.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensor_m
+  implicit none
+
+  type tensor_t(k)
+    integer, kind :: k = kind(0.)
+  end type
+
+  interface tensor_t
+    module function tensor(unused_stuff)
+      implicit none
+      real unused_stuff
+      type(tensor_t) tensor
+    end function
+  end interface
+
+end module
+
+  use tensor_m
+  implicit none
+contains
+  function test_passed()
+    logical test_passed
+    type(tensor_t), allocatable :: tensor_array(:)
+    real, parameter :: junk = 0.
+    tensor_array = [tensor_t(junk)] !Error: Symbol ‘junk’ at (1) has no IMPLICIT type
+    test_passed =  .false.          !Error: ‘test_passed’ at (1) is not a variable
+  end function
+end