fortran: Fix iterator counting in nested block scopes [PR fortran/124208]

Count FORALL/DO CONCURRENT iterators in EXEC_BLOCK namespace code chains
while sizing VAR_EXPR in gfc_resolve_forall.

This prevents undersized allocation and an ICE for nested FORALL/DO
CONCURRENT inside ASSOCIATE/BLOCK constructs.

	PR fortran/124208

gcc/fortran/ChangeLog:

	* resolve.cc (gfc_max_forall_iterators_in_chain): Count
	iterators in EXEC_BLOCK namespaces.

gcc/testsuite/ChangeLog:

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

Signed-off-by: Christopher Albert <albert@tugraz.at>

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 655db8a1c9cf87e7d04930efb526d4245de07e67..d28d00a03a00d7531b9d634c34da17b015a57a8e 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -12449,6 +12449,13 @@ gfc_max_forall_iterators_in_chain (gfc_code *code)
 
       if (c->op == EXEC_FORALL || c->op == EXEC_DO_CONCURRENT)
        sub_iters = gfc_count_forall_iterators (c);
+      else if (c->op == EXEC_BLOCK)
+       {
+         /* BLOCK/ASSOCIATE bodies live in the block namespace code chain,
+            not in the generic c->block arm list used by IF/SELECT.  */
+         if (c->ext.block.ns && c->ext.block.ns->code)
+           sub_iters = gfc_max_forall_iterators_in_chain (c->ext.block.ns->code);
+       }
       else if (c->block)
        for (gfc_code *b = c->block; b; b = b->block)
          {

diff --git a/gcc/testsuite/gfortran.dg/pr124208.f90 b/gcc/testsuite/gfortran.dg/pr124208.f90
new file mode 100644 (file)
index 0000000..be833d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr124208.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! PR fortran/124208
+
+subroutine nested_forall_in_associate
+  implicit none
+  integer :: lane
+  integer :: box(6)
+
+  box = 0
+  do concurrent (lane = 1:4)
+    associate (idx => lane)
+      forall (idx = 1:3, box(idx) == 0)
+        box(mod (idx + lane - 1, 3) + 1) = idx + lane
+      end forall
+    end associate
+  end do
+end subroutine nested_forall_in_associate
+
+subroutine shadowed_do_concurrent_blocks
+  implicit none
+  integer :: i
+  integer :: acc(8)
+
+  acc = 0
+  block
+    integer :: i
+    i = 2
+    do concurrent (i = 1:3)
+      associate (base => i)
+      block
+        integer :: i
+        i = base + 1
+        do concurrent (i = base + 1:5)
+          acc(i) = acc(i) + i
+        end do
+      end block
+      end associate
+    end do
+  end block
+end subroutine shadowed_do_concurrent_blocks