On 6/14/26 1:15 AM, Thomas Koenig wrote:
Hi Jerry,


This patch fixes a problem with nested DO_CONCURRENT loops. In short, shadow variables were not unique between the nested levels.

Regression tested on x86_64.

OK for mainline?

I have a couple of questions.

+      int nunderscore = 1;
+      name = (char *) alloca (strlen (v->symtree->name) + 32);

This restricts the number of underscores to 32, and will break if there
are more.  I would suggest declaring a static counter which adds the
number to a string, like n_vars in frontend-passes.cc , which is then
used in create_vars.


I have updated the patch, attached, to remove the limitation on underscores and use a counter to generate unique names.

The test case do_concurrent_typesspec_f90 has

+  s2 = 0
+  total = 0
+  do concurrent (integer :: i = 1:2)
+    s2 = s2 + i
+    do concurrent (integer(2) :: i = 1:3)
+      total = total + int (i, kind (total))
+    end do
+  end do

As far as I read the Fortran standard, the

   do concurrent (integer :: i = 1:2)
     s2 = s2 + i

is illegal because s2 has unspecified locality, and
11.1.7.5 Additional semantics for DO CONCURRENT constructs
states (paragraph 7)


Agree, I reviewed my copy of the 2023 draft standard as well. I think it is on the user to not do this. I updated the test cases to used reduce to ensure validity for all the test cases

If we want to diagnose someone doing the wrong things I think that needs to be for later effort.

If a variable has unspecified locality

if it is referenced in an iteration it shall either be previously
defined during that iteration, or shall not be defined or become
undefined during any other iteration; if it is defined or becomes
undefined by more than one iteration it becomes undefined when the loop
terminates;

[...]

Would the patch also work for the (slightly nonsensical, but also
legal, AFAIK)

do concurrent (integer :: i = 1:2)
   do concurrent (integer(2) :: i = 1:3)
     do concurrent (integer(8) :: i = 1:3)


Yes and a similar testcase is included.

And finally, I didn't dig deep enough into the standard to see if

do concurrent (integer :: i = 1:2)
   do concurrent (integer(2) :: i = 1:3)
     do concurrent (integer :: i = 1:3)

is legal or not, and what the compiler should do in this case.


Yes the above I think is legal and will compile.

Best regards

     Thomas

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

Reply via email to