OpenMP: Fix bogus diagnostics with intervening code [PR121452]

The introduction in r14-3488-ga62c8324e7e31a of OMP_STRUCTURED_BLOCK (to
diagnose invalid intervening code) caused a regression rejecting the valid use
of the Fortran CONTINUE statement to end a collapsed loop.
This patch fixes the incorrect error checking in the OMP lowering pass. It also
fixes a check in the Fortran front end that erroneously rejects a similar
statement in an ordered loop.

Co-authored by: Tobias Burnus <tburnus@baylibre.com>

	PR fortran/121452

gcc/fortran/ChangeLog:

	* openmp.cc (resolve_omp_do): Allow CONTINUE as end statement of a
	perfectly nested loop.

gcc/ChangeLog:

	* omp-low.cc (check_omp_nesting_restrictions): Accept an
	OMP_STRUCTURED_BLOCK in a collapsed simd region and in an ordered loop.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/pr121452-1.c: New test.
	* c-c++-common/gomp/pr121452-2.c: New test.
	* gfortran.dg/gomp/pr121452-1.f90: New test.
	* gfortran.dg/gomp/pr121452-2.f90: New test.
	* gfortran.dg/gomp/pr121452-3.f90: New test.

(cherry picked from commit 6b90d56d0c352a151efabe06f81d26faeeb9496f)

7 files changed, 102 insertions, 3 deletions

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 0c6b2e0806d..7a915adbb9d 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -12701,7 +12701,8 @@ resolve_omp_do (gfc_code *code)
 		     name, i, &code->loc);
 	  goto fail;
 	}
-      else if (next != do_code->block->next || next->next)
+      else if (next != do_code->block->next
+	       || (next->next && next->next->op != EXEC_CONTINUE))
 	/* Imperfectly nested loop found.  */
 	{
 	  /* Only diagnose violation of imperfect nesting constraints once.  */
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index b6a57fbcc2b..8679a796b24 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -3765,7 +3765,8 @@ check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx)
 	    }
 	  else if (gimple_code (stmt) == GIMPLE_OMP_ATOMIC_LOAD
 		   || gimple_code (stmt) == GIMPLE_OMP_ATOMIC_STORE
-		   || gimple_code (stmt) == GIMPLE_OMP_SCAN)
+		   || gimple_code (stmt) == GIMPLE_OMP_SCAN
+		   || gimple_code (stmt) == GIMPLE_OMP_STRUCTURED_BLOCK)
 	    return true;
 	  else if (gimple_code (stmt) == GIMPLE_OMP_FOR
 		   && gimple_omp_for_kind (ctx->stmt) == GF_OMP_FOR_KIND_SIMD)
@@ -3795,7 +3796,8 @@ check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx)
 	       && gimple_code (stmt) != GIMPLE_OMP_PARALLEL
 	       && (gimple_code (stmt) != GIMPLE_OMP_FOR
 		   || gimple_omp_for_kind (stmt) != GF_OMP_FOR_KIND_SIMD)
-	       && gimple_code (stmt) != GIMPLE_OMP_SCAN)
+	       && gimple_code (stmt) != GIMPLE_OMP_SCAN
+	       && gimple_code (stmt) != GIMPLE_OMP_STRUCTURED_BLOCK)
 	{
 	  if (ctx->loop_p)
 	    error_at (gimple_location (stmt),
diff --git a/gcc/testsuite/c-c++-common/gomp/pr121452-1.c b/gcc/testsuite/c-c++-common/gomp/pr121452-1.c
new file mode 100644
index 00000000000..d605919e565
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/pr121452-1.c
@@ -0,0 +1,17 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+/* Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted.
+ */
+
+void f(int *A, int *B, int *C)
+{
+  #pragma omp for simd collapse(2)
+  for (int i=0; i < 1; i++) {
+    for (int j=0; j < 1; j++)
+      A[i] += B[j];
+    C[i] = 4;
+  }
+}
+
+/* { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/pr121452-2.c b/gcc/testsuite/c-c++-common/gomp/pr121452-2.c
new file mode 100644
index 00000000000..35fb1c1534b
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/pr121452-2.c
@@ -0,0 +1,17 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+/* Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted.
+ */
+
+void f(int *A, int *B, int *C)
+{
+  #pragma omp loop bind(teams) order(concurrent) collapse(2)
+  for (int i=0; i < 1; i++) {
+    for (int j=0; j < 1; j++)
+      A[i] += B[j];
+    C[i] = 4;
+  }
+}
+
+/* { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } } */
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr121452-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr121452-1.f90
new file mode 100644
index 00000000000..60697c98ae3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr121452-1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+! Check that the front end acccepts a CONTINUE statement
+! inside an ordered loop.
+
+implicit none
+integer :: i, j
+integer :: A(5,5), B(5,5) = 1
+
+!$omp do ordered(2)
+   do 10 i = 1, 5
+     do 20 j = 1, 5
+       A(i,j) = B(i,j)
+20   continue
+10 continue
+
+if (any(A /= 1)) stop 1
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr121452-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr121452-2.f90
new file mode 100644
index 00000000000..ab020d4bf91
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr121452-2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+! Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted by
+! the OMP lowering pass.
+
+implicit none
+integer :: i, j, x
+integer :: A(5,5), B(5,5) = 1
+
+!$omp simd collapse(2)
+   do i = 1, 5
+     do j = 1, 5
+       A(i,j) = B(i,j)
+    end do
+    x = 1 ! intervening code
+  end do
+
+if (any(A /= 1)) stop 1
+end
+
+! { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr121452-3.f90 b/gcc/testsuite/gfortran.dg/gomp/pr121452-3.f90
new file mode 100644
index 00000000000..605f92c99cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr121452-3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+! Check that the OMP_STRUCTURED_BLOCK that wraps intervening code is accepted by
+! the OMP lowering pass.
+
+
+implicit none
+integer :: i, j
+integer :: A(5,5), B(5,5) = 1
+
+!$omp simd collapse(2)
+   do 10 i = 1, 5
+     do 20 j = 1, 5
+       A(i,j) = B(i,j)
+20   continue
+10 continue
+
+if (any(A /= 1)) stop 1
+end
+
+! { dg-final { scan-tree-dump "#pragma omp __structured_block" "original" } }