This one is straightforward.

See attached.

Regression tested on x86_64.

OK for mainline? and then backport to 16.

Regards,

Jerry

---
fortran: ICE in DO CONCURRENT with DEFAULT(NONE) inside ASSOCIATE

Two bugs in check_default_none_expr caused a segfault when a DO CONCURRENT
with inline type-spec iterators (e.g. "integer :: i = 1:10") contained an
ASSOCIATE construct.

Bug 1: sym->ns->code was used to locate the ext.concur.forall_iterator
list.  When a symbol's namespace is an ASSOCIATE body, sym->ns->code is an
EXEC_BLOCK node, not the DO CONCURRENT node; reading ext.concur from it
interprets the wrong union member and yields a garbage pointer.  Fix: use
d->code instead, the DO CONCURRENT gfc_code node passed through the walker's
data parameter, which is always the correct node.

Bug 2: inline type-spec iterators are shadow iterators, stored internally
with a leading underscore prepended to the name.  The comparison of the
iterator's symtree name against the user-visible sym->name must skip that
underscore by advancing iter_name one character when iter->shadow is set.

PR fortran/125529

Assisted by: Claude Sonnet 4.6

gcc/fortran/ChangeLog:

        PR fortran/125529
        * resolve.cc (check_default_none_expr): Use d->code instead of
        sym->ns->code to locate the DO CONCURRENT forall_iterator list,
        avoiding a wrong-union-member read when the symbol's namespace is
        an ASSOCIATE body.  Skip leading underscore when comparing iterator
        names for shadow iterators.

gcc/testsuite/ChangeLog:

        PR fortran/125529
        * gfortran.dg/do_concurrent_assoc_default_none.f90: New test.
From d184c3c93f3de6132b8ac466b3ecb0f0a33dda4c Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Wed, 27 May 2026 21:00:19 -0700
Subject: [PATCH] fortran: ICE in DO CONCURRENT with DEFAULT(NONE) inside
 ASSOCIATE

Two bugs in check_default_none_expr caused a segfault when a DO CONCURRENT
with inline type-spec iterators (e.g. "integer :: i = 1:10") contained an
ASSOCIATE construct.

Bug 1: sym->ns->code was used to locate the ext.concur.forall_iterator
list.  When a symbol's namespace is an ASSOCIATE body, sym->ns->code is an
EXEC_BLOCK node, not the DO CONCURRENT node; reading ext.concur from it
interprets the wrong union member and yields a garbage pointer.  Fix: use
d->code instead, the DO CONCURRENT gfc_code node passed through the walker's
data parameter, which is always the correct node.

Bug 2: inline type-spec iterators are shadow iterators, stored internally
with a leading underscore prepended to the name.  The comparison of the
iterator's symtree name against the user-visible sym->name must skip that
underscore by advancing iter_name one character when iter->shadow is set.

PR fortran/125529

Assisted by: Claude Sonnet 4.6

gcc/fortran/ChangeLog:

	PR fortran/125529
	* resolve.cc (check_default_none_expr): Use d->code instead of
	sym->ns->code to locate the DO CONCURRENT forall_iterator list,
	avoiding a wrong-union-member read when the symbol's namespace is
	an ASSOCIATE body.  Skip leading underscore when comparing iterator
	names for shadow iterators.

gcc/testsuite/ChangeLog:

	PR fortran/125529
	* gfortran.dg/do_concurrent_assoc_default_none.f90: New test.
---
 gcc/fortran/resolve.cc                        | 24 ++++++++-----
 .../do_concurrent_assoc_default_none.f90      | 35 +++++++++++++++++++
 2 files changed, 51 insertions(+), 8 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/do_concurrent_assoc_default_none.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index df91671e171..b9078fd8722 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8597,15 +8597,23 @@ check_default_none_expr (gfc_expr **e, int *, void *data)
 	      ns2 = ns2->parent;
 	    }
 
-	  /* A DO CONCURRENT iterator cannot appear in a locality spec.  */
-	  if (sym->ns->code->ext.concur.forall_iterator)
+	  /* A DO CONCURRENT iterator cannot appear in a locality spec.
+	     Use d->code (the DO CONCURRENT node) rather than sym->ns->code,
+	     which may be a different code type (e.g. EXEC_ASSOCIATE) whose
+	     ext union would be read incorrectly.  */
+	  for (gfc_forall_iterator *iter = d->code->ext.concur.forall_iterator;
+	       iter; iter = iter->next)
 	    {
-	      gfc_forall_iterator *iter
-		= sym->ns->code->ext.concur.forall_iterator;
-	      for (; iter; iter = iter->next)
-		if (iter->var->symtree
-		    && strcmp(sym->name, iter->var->symtree->name) == 0)
-		  return 0;
+	      if (!iter->var || !iter->var->symtree)
+		continue;
+	      const char *iter_name = iter->var->symtree->name;
+	      /* Shadow iterators (from inline type-spec: integer :: i = ...)
+		 store the iterator with a leading underscore internally; the
+		 user-visible name does not have the underscore.  */
+	      if (iter->shadow)
+		iter_name++;
+	      if (strcmp (sym->name, iter_name) == 0)
+		return 0;
 	    }
 
 	  /* A named constant is not a variable, so skip test.  */
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_assoc_default_none.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_assoc_default_none.f90
new file mode 100644
index 00000000000..f1cb2718907
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_assoc_default_none.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+!
+! PR fortran/125515
+! DO CONCURRENT with inline type-spec iterators and DEFAULT(NONE) inside an
+! ASSOCIATE block used to ICE (segfault in check_default_none_expr).  The
+! bug was that sym->ns->code was used instead of d->code to locate the
+! forall_iterator list; for symbols in an ASSOCIATE or enclosing procedure
+! namespace the wrong union member was read, giving a garbage pointer.
+! Additionally, shadow iterators store their name with a leading underscore
+! internally, so the comparison against user-visible names must strip it.
+
+subroutine test_associate_default_none (a, b)
+  implicit none
+  integer, intent(in)  :: a(10,10)
+  integer, intent(out) :: b(10,10)
+  do concurrent (integer :: i = 1:10, j = 1:10) &
+      default(none) shared(a, b)
+    associate (tmp => a(i,j))
+      b(i,j) = tmp + 1
+    end associate
+  end do
+end subroutine
+
+! Verify that a genuinely missing variable still gets an error.
+subroutine test_missing_var (a, b, c)
+  implicit none
+  integer, intent(in)  :: a(10,10), c
+  integer, intent(out) :: b(10,10)
+  do concurrent (integer :: i = 1:10, j = 1:10) &
+      default(none) shared(a, b)
+    ! { dg-error "not specified in a locality spec" "" { target *-*-* } .-1 }
+    b(i,j) = a(i,j) + c   ! { dg-error "not specified in a locality spec" }
+  end do
+end subroutine
-- 
2.54.0

Reply via email to