]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Fix check on locality spec DO CONCURRENT
authorSteve Kargl <kargls@comcast.net>
Mon, 3 Nov 2025 19:47:54 +0000 (11:47 -0800)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Mon, 3 Nov 2025 20:31:10 +0000 (12:31 -0800)
PR fortran/122513

gcc/fortran/ChangeLog:

* resolve.cc (check_default_none_expr): Do not allow an
iterator in a locality spec. Allow a named constant to be
used within the loop.

gcc/testsuite/ChangeLog:

* gfortran.dg/pr122513.f90: New test.

gcc/fortran/resolve.cc
gcc/testsuite/gfortran.dg/pr122513.f90 [new file with mode: 0644]

index 03e26f000843801fc1a44a652c013409062e56ef..5fa408ec48ccafa04b5450143359a5bd6d497696 100644 (file)
@@ -8461,7 +8461,20 @@ check_default_none_expr (gfc_expr **e, int *, void *data)
                break;
              ns2 = ns2->parent;
            }
-         if (ns2 != NULL)
+
+         /* A DO CONCURRENT iterator cannot appear in a locality spec.  */
+         if (sym->ns->code->ext.concur.forall_iterator)
+           {
+             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;
+           }
+
+         /* A named constant is not a variable, so skip test.  */
+         if (ns2 != NULL && sym->attr.flavor != FL_PARAMETER)
            {
              gfc_error ("Variable %qs at %L not specified in a locality spec "
                        "of DO CONCURRENT at %L but required due to "
diff --git a/gcc/testsuite/gfortran.dg/pr122513.f90 b/gcc/testsuite/gfortran.dg/pr122513.f90
new file mode 100644 (file)
index 0000000..9e12ab1
--- /dev/null
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR122513 do concurrent default (none) fails on parameter arrays
+program test
+  implicit none
+  integer :: i
+  do concurrent (i=1:2) default (none)
+     block
+       integer, dimension(2,3), parameter :: &
+            ii = reshape((/ 1,2,3,4,5,6 /), (/2, 3/))
+       print*,ii(i,:)
+     end block
+  end do
+end program test