Re: [PATCH] [PR125747] Fix shadow-variable bugs for DO, CONCURRENT/FORALL type-spec

From 423deda167c480f902a9278bbbd96eb9209cd03e Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Thu, 11 Jun 2026 12:05:15 -0700
Subject: [PATCH] fortran: [PR125747] Fix shadow-variable bugs for DO
 CONCURRENT/FORALL type-spec

When a DO CONCURRENT or FORALL construct gives its index-name an
explicit type-spec (F2018 19.4(6)) and that name already exists in the
enclosing scope, the front end creates a "shadow" variable with the
requested type and substitutes references to the outer-scope variable
with the shadow inside the construct's body.  Three related bugs in
this mechanism could cause an ICE or wrong code:

1. The shadow variable was always named "_<name>", so two sibling
   constructs reusing the same index-name with different type-specs
   ended up sharing (and mutating) the same shadow symbol, corrupting
   already-resolved bounds and triggering an ICE in
   gfc_add_modify_loc.

2. gfc_resolve_forall derived the shadowed outer-scope symbol by
   stripping a single leading underscore from the shadow variable's
   name.  Once shadow names were uniquified (fix 1) this derivation
   broke for "__name", "___name", etc., causing the body substitution
   to target the wrong symbol and produce wrong runtime values.

3. The generic block-recursion in replace_in_code_recursive
   unconditionally descended into nested FORALL/DO CONCURRENT bodies
   during an outer construct's substitution pass, prematurely
   rewriting references to the shared index-name before the nested
   construct (which shadows the same name itself) performed its own
   substitution.

Fix: uniquify shadow-variable names against the current namespace
using a monotonically increasing counter, record the shadowed
outer-scope symbol directly in a new shadow_outer_sym field instead
of deriving it from the shadow name, and skip block-recursion into
nested FORALL/DO CONCURRENT constructs that shadow the same outer
symbol.

Assisted by: Claude Sonnet 4.6

	PR fortran/125747

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_forall_iterator): Add shadow_outer_sym field.
	* match.cc (apply_typespec_to_iterator): Uniquify the shadow
	variable name against the current namespace using a monotonically
	increasing counter, and record the shadowed outer-scope symbol in
	shadow_outer_sym.
	* resolve.cc (replace_in_code_recursive): Skip recursing into a
	nested FORALL/DO CONCURRENT body that itself shadows old_sym.
	(gfc_resolve_forall): Use shadow_outer_sym directly instead of
	deriving the shadowed symbol from the shadow variable's name.

gcc/testsuite/ChangeLog:

	* gfortran.dg/do_concurrent_typespec_2.f90: New test.
	* gfortran.dg/do_concurrent_typespec_3.f90: New test.
	* gfortran.dg/do_concurrent_typespec_4.f90: New test.
---
 gcc/fortran/gfortran.h                        |  2 +
 gcc/fortran/match.cc                          | 21 +++++++--
 gcc/fortran/resolve.cc                        | 46 ++++++++++---------
 .../gfortran.dg/do_concurrent_typespec_2.f90  | 32 +++++++++++++
 .../gfortran.dg/do_concurrent_typespec_3.f90  | 32 +++++++++++++
 .../gfortran.dg/do_concurrent_typespec_4.f90  | 35 ++++++++++++++
 6 files changed, 142 insertions(+), 26 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/do_concurrent_typespec_2.f90
 create mode 100644 gcc/testsuite/gfortran.dg/do_concurrent_typespec_3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/do_concurrent_typespec_4.f90

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ef6239cd667..4c9eeda43a2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3179,6 +3179,8 @@ typedef struct gfc_forall_iterator
   gfc_loop_annot annot;
   /* index-name shadows a variable from outer scope.  */
   bool shadow;
+  /* The shadowed outer-scope symbol, set when SHADOW is true.  */
+  gfc_symbol *shadow_outer_sym;
   struct gfc_forall_iterator *next;
 }
 gfc_forall_iterator;
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index ef6be2d2496..6ff3a4a01db 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -2819,6 +2819,10 @@ cleanup:
 }
 
 
+/* Counter used to uniquify shadow-variable names created below.  */
+
+static int shadow_var_num = 0;
+
 /* Apply type-spec to iterator and create shadow variable if needed.  */
 
 static void
@@ -2846,14 +2850,23 @@ apply_typespec_to_iterator (gfc_forall_iterator *iter, gfc_typespec *ts,
   else
     {
       /* Variable exists in outer scope - must create shadow to comply
-	 with F2018 19.4(6) scoping rules.  */
-      name = (char *) alloca (strlen (v->symtree->name) + 2);
-      strcpy (name, "_");
-      strcat (name, v->symtree->name);
+	 with F2018 19.4(6) scoping rules.  A sibling DO CONCURRENT/FORALL
+	 construct using the same index-name may already have created a
+	 shadow with the same name; uniquify against a monotonically
+	 increasing counter so that distinct constructs do not share (and
+	 mutate) the same shadow symbol.  */
+      name = (char *) alloca (GFC_MAX_SYMBOL_LEN + 1);
+      do
+	snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "_%s_%d",
+		  v->symtree->name, shadow_var_num++);
+      while (gfc_find_symtree (gfc_current_ns->sym_root, name) != NULL);
+
       if (gfc_get_sym_tree (name, NULL, &st, false) != 0)
 	gfc_internal_error ("Failed to create shadow variable symtree for "
 			    "DO CONCURRENT type-spec at %L", loc);
 
+      iter->shadow_outer_sym = iter->var->symtree->n.sym;
+
       v = gfc_get_expr ();
       v->where = gfc_current_locus;
       v->expr_type = EXPR_VARIABLE;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 8d2a0349881..c326bc4f3d1 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -12767,8 +12767,22 @@ replace_in_code_recursive (gfc_code *code, gfc_symbol *old_sym, gfc_symtree *new
 	  break;
 	}
 
-      /* Recurse into blocks */
-      if (c->block)
+      /* Recurse into blocks, unless this is a nested FORALL/DO CONCURRENT
+	 that itself shadows OLD_SYM with its own type-spec; such a nested
+	 construct replaces references to OLD_SYM in its own body with its
+	 own shadow variable, so this outer substitution must not touch
+	 them first.  */
+      bool skip_nested_shadow = false;
+      if (c->op == EXEC_FORALL || c->op == EXEC_DO_CONCURRENT)
+	for (gfc_forall_iterator *fa = c->ext.concur.forall_iterator;
+	     fa; fa = fa->next)
+	  if (fa->shadow && fa->shadow_outer_sym == old_sym)
+	    {
+	      skip_nested_shadow = true;
+	      break;
+	    }
+
+      if (c->block && !skip_nested_shadow)
 	replace_in_code_recursive (c->block->next, old_sym, new_st);
     }
 }
@@ -12863,30 +12877,18 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
 	{
 	  if (fa->shadow)
 	    {
-	      gfc_symtree *shadow_st;
-	      const char *shadow_name_str;
-	      char *outer_name;
+	      gfc_symtree *shadow_st = fa->var->symtree;
 
-	      /* fa->var now points to the shadow variable "_name".  */
-	      shadow_name_str = fa->var->symtree->name;
-	      shadow_st = fa->var->symtree;
+	      /* The outer-scope symbol being shadowed was recorded by
+		 apply_typespec_to_iterator; using it directly avoids
+		 deriving it from the shadow variable's name, which is
+		 not reliable once uniquified (e.g. "__i", "___i", ...)
+		 to avoid colliding with sibling constructs' shadows.  */
+	      gfc_symbol *iter_sym = fa->shadow_outer_sym;
 
-	      if (shadow_name_str[0] != '_')
-		gfc_internal_error ("Expected shadow variable name to start with _");
-
-	      outer_name = (char *) alloca (strlen (shadow_name_str));
-	      strcpy (outer_name, shadow_name_str + 1);
-
-	      /* Find the ITERATOR symbol in the current namespace.
-		 This is the local DO CONCURRENT variable that body expressions reference.  */
-	      gfc_symtree *iter_st = gfc_find_symtree (ns->sym_root, outer_name);
-
-	      if (!iter_st)
-		/* No iterator variable found - this shouldn't happen */
+	      if (!iter_sym)
 		continue;
 
-	      gfc_symbol *iter_sym = iter_st->n.sym;
-
 	      /* Walk the FORALL/DO CONCURRENT body and replace all references.  */
 	      if (code->block && code->block->next)
 		gfc_replace_forall_variable (&code->block->next, iter_sym, shadow_st);
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_typespec_2.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_2.f90
new file mode 100644
index 00000000000..378fd22df1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+!
+! PR fortran/125747
+! Three consecutive DO CONCURRENT constructs reuse the index-name 'i'
+! with type-specs.  The second and third constructs each need a shadow
+! variable per F2018 19.4(6); they used to be assigned the same shadow
+! symbol "_i", and the third construct's INTEGER(2) type-spec mutated
+! the shadow symbol shared with the second construct, leaving its
+! already-converted INTEGER(4) bounds inconsistent with the (now
+! INTEGER(2)) loop variable and causing an ICE in gfc_add_modify_loc.
+
+program p
+  implicit none
+  integer :: s1, s2, s3
+
+  s1 = 0
+  do concurrent (integer :: i = 1:3) reduce(+:s1)
+    s1 = s1 + i
+  end do
+
+  s2 = 0
+  do concurrent (integer :: i = 1:3) reduce(+:s2)
+    s2 = s2 + i
+  end do
+
+  s3 = 0
+  do concurrent (integer(2) :: i = 1:3) reduce(+:s3)
+    s3 = s3 + int (i, kind (s3))
+  end do
+
+  if (s1 /= 6 .or. s2 /= 6 .or. s3 /= 6) stop 1
+end program p
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_typespec_3.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_3.f90
new file mode 100644
index 00000000000..82b4648aeda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_3.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+!
+! PR fortran/125747
+! A nested DO CONCURRENT that re-shadows the same index-name 'i' as its
+! enclosing construct, with a different type-spec.  The outer construct's
+! body-substitution (i -> its shadow) must not also rewrite references to
+! 'i' inside the nested construct's body, since the nested construct
+! shadows 'i' itself and performs its own substitution.
+
+program p
+  implicit none
+  integer :: s1, s2, total
+
+  ! Establish 'i' as INTEGER(4) via a prior sibling construct.
+  s1 = 0
+  do concurrent (integer :: i = 1:3) reduce(+:s1)
+    s1 = s1 + i
+  end do
+
+  s2 = 0
+  total = 0
+  do concurrent (integer :: i = 1:2) reduce(+:s2)
+    s2 = s2 + i
+    do concurrent (integer(2) :: i = 1:3) reduce(+:total)
+      total = total + int (i, kind (total))
+    end do
+  end do
+
+  if (s1 /= 6) stop 1
+  if (s2 /= 3) stop 2
+  if (total /= 12) stop 3
+end program p
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_typespec_4.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_4.f90
new file mode 100644
index 00000000000..cacb76f5481
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_typespec_4.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR fortran/125747
+! Deeper nesting of DO CONCURRENT constructs that all reuse the
+! index-name 'i' with type-specs, each shadowing the same outer-scope
+! symbol.  Exercises three levels with three distinct kinds, and a
+! non-monotonic reuse where the innermost construct repeats the
+! outermost construct's type-spec.
+
+program p
+  implicit none
+  integer :: total1, total2
+
+  ! Three levels, three distinct kinds (default, kind=2, kind=8).
+  total1 = 0
+  do concurrent (integer :: i = 1:2) reduce(+:total1)
+    do concurrent (integer(2) :: i = 1:2) reduce(+:total1)
+      do concurrent (integer(8) :: i = 1:2) reduce(+:total1)
+        total1 = total1 + int (i, kind (total1))
+      end do
+    end do
+  end do
+  if (total1 /= 12) stop 1
+
+  ! Innermost construct reuses the outermost construct's type-spec.
+  total2 = 0
+  do concurrent (integer :: i = 1:2) reduce(+:total2)
+    do concurrent (integer(2) :: i = 1:2) reduce(+:total2)
+      do concurrent (integer :: i = 1:2) reduce(+:total2)
+        total2 = total2 + i
+      end do
+    end do
+  end do
+  if (total2 /= 12) stop 2
+end program p
-- 
2.54.0