OpenMP/Fortran: Non-rectangular loops with constant steps other than 1 or -1 [PR107424]

Before this commit, gfortran produced with OpenMP for 'do i = 1,10,2'
the code
  for (count.0 = 0; count.0 < 5; count.0 = count.0 + 1)
    i = count.0 * 2 + 1;

While such an inner loop can be collapsed, a non-rectangular could not.
With this commit and for all constant loop steps, a simple loop such
as 'for (i = 1; i <= 10; i = i + 2)' is created. (Before only for the
constant steps of 1 and -1.)

The constant step permits to know the direction (increasing/decreasing)
that is required for the loop condition.

The new code is only valid if one assumes no overflow of the loop variable.
However, the Fortran standard can be read that this must be ensured by
the user. Namely, the Fortran standard requires (F2023, 10.1.5.2.4):
"The execution of any numeric operation whose result is not defined by
the arithmetic used by the processor is prohibited."

And, for DO loops, F2023's "11.1.7.4.3 The execution cycle" has the
following: The number of loop iterations handled by an iteration count,
which would permit code like 'do i = huge(i)-5, huge(i),4'. However,
in step (3), this count is not only decremented by one but also:
  "... The DO variable, if any, is incremented by the value of the
  incrementation parameter m3."
And for the example above, 'i' would be 'huge(i)+3' in the last
execution cycle, which exceeds the largest model number and should
render the example as invalid.

	PR fortran/107424

gcc/fortran/ChangeLog:

	* trans-openmp.cc (gfc_nonrect_loop_expr): Accept all
	constant loop steps.
	(gfc_trans_omp_do): Likewise; use sign to determine
	loop direction.

libgomp/ChangeLog:

	* libgomp.texi (Impl. Status 5.0): Add link to new PR110735.
	* testsuite/libgomp.fortran/non-rectangular-loop-1.f90: Enable
	commented tests.
	* testsuite/libgomp.fortran/non-rectangular-loop-1a.f90: Remove
	test file; tests are in non-rectangular-loop-1.f90.
	* testsuite/libgomp.fortran/non-rectangular-loop-5.f90: Change
	testcase to use a non-constant step to retain the 'sorry' test.
	* testsuite/libgomp.fortran/non-rectangular-loop-6.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/linear-2.f90: Update dump to remove
	the additional count variable.

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index c88ee3c7656efc4fa4aeee52912ad7fe8c3d9331..cf741cebf91b7596940c8656568b67276211fb90 100644 (file)
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -5374,10 +5374,10 @@ gfc_nonrect_loop_expr (stmtblock_t *pblock, gfc_se *sep, int loop_n,
 
   if (!simple)
     {
-      /* FIXME: Handle non-unit iter steps, cf. PR fortran/107424.  */
+      /* FIXME: Handle non-const iter steps, cf. PR fortran/110735.  */
       sorry_at (gfc_get_location (&curr_loop_var->where),
-               "non-rectangular loop nest with step other than constant 1 "
-               "or -1 for %qs", curr_loop_var->symtree->n.sym->name);
+               "non-rectangular loop nest with non-constant step for %qs",
+               curr_loop_var->symtree->n.sym->name);
       return false;
     }
 
@@ -5394,10 +5394,10 @@ gfc_nonrect_loop_expr (stmtblock_t *pblock, gfc_se *sep, int loop_n,
          }
        else
          {
-           /* FIXME: Handle non-unit iter steps, cf. PR fortran/107424.  */
+           /* FIXME: Handle non-const iter steps, cf. PR fortran/110735.  */
            sorry_at (gfc_get_location (&code->loc),
-                     "non-rectangular loop nest with step other than constant "
-                     "1 or -1 for %qs", var->name);
+                     "non-rectangular loop nest with non-constant step "
+                     "for %qs", var->name);
            inform (gfc_get_location (&expr->where), "Used here");
            return false;
          }
@@ -5578,10 +5578,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
       gfc_add_block_to_block (pblock, &se.pre);
       step = gfc_evaluate_now (se.expr, pblock);
 
-      if (integer_onep (step))
-       simple = 1;
-      else if (tree_int_cst_equal (step, integer_minus_one_node))
-       simple = -1;
+      if (TREE_CODE (step) == INTEGER_CST)
+       simple = tree_int_cst_sgn (step);
 
       gfc_init_se (&se, NULL);
       if (!clauses->non_rectangular

diff --git a/gcc/testsuite/gfortran.dg/gomp/linear-2.f90 b/gcc/testsuite/gfortran.dg/gomp/linear-2.f90
index 05f007fd5c213394c161d503e3b5bf105cf84d94..88df96e9b8f1fcbd5e0ee5607352f453986e4bf2 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gomp/linear-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/linear-2.f90
@@ -105,8 +105,8 @@ end module
 ! { dg-final { scan-tree-dump-times "#pragma omp for nowait" 6 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp for linear\\(x:D\\.\[0-9\]+\\) nowait" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp for linear\\(x:val,step\\(D\\.\[0-9\]+\\)\\) nowait" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(count\\.\[0-9\]:1\\) linear\\(i:3\\)" 2 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(count\\.\[0-9\]:1\\) linear\\(i:val,step\\(3\\)\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:3\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:val,step\\(3\\)\\)" 2 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) linear\\(x:D\\.\[0-9\]+\\)" 2 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) linear\\(x:val,step\\(D\\.\[0-9\]+\\)\\)" 2 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:D\\.\[0-9\]+\\)" 2 "original" } }

diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 639dd05eb7ba2cfe9929fc03264f70ff00c58ab9..a8582b50177eaa03216b5998ebd1f5522f3cb08a 100644 (file)
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -194,7 +194,9 @@ The OpenMP 4.5 specification is fully supported.
 @item @code{requires} directive @tab P
       @tab complete but no non-host device provides @code{unified_shared_memory}
 @item @code{teams} construct outside an enclosing target region @tab Y @tab
-@item Non-rectangular loop nests @tab P @tab Full support for C/C++, partial for Fortran
+@item Non-rectangular loop nests @tab P
+      @tab Full support for C/C++, partial for Fortran
+           (@uref{https://gcc.gnu.org/PR110735,PR110735})
 @item @code{!=} as relational-op in canonical loop form for C/C++ @tab Y @tab
 @item @code{nonmonotonic} as default loop schedule modifier for worksharing-loop
       constructs @tab Y @tab

diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90
index dbbd18a14441e0ed88215975b78566ea327237ea..d074d4de5a01667040cac566b90f66435d396f22 100644 (file)
--- a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90
@@ -6,9 +6,6 @@
 
 ! Nonrectangular loop nests checks
 
-! See PR or non-rectangular-loop-1a.f90 for the commented tests
-! Hint: Those use step for loop vars part of nonrectangular loop nests
-
 module m
   implicit none (type, external)
 contains
@@ -26,32 +23,32 @@ subroutine lastprivate_check_simd_1
   ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
   ! Then same, except use non-unit step for 'k'
 
-!  !$omp simd collapse(3) lastprivate(k)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-
-!  !$omp simd collapse(3) lastprivate(k)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
+  !$omp simd collapse(3) lastprivate(k)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+
+  !$omp simd collapse(3) lastprivate(k)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
 
   !$omp simd collapse(3) lastprivate(k)
   do i = 1, n, 2
     do j = 1, m
       do k = j - 41, p
         if (k < 1 - 41 .or. k > p) then
-          print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
+          ! print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
           error stop
         end if
       end do
@@ -66,7 +63,7 @@ subroutine lastprivate_check_simd_1
     do j = 1, m
       do k = j - 41, p
         if (k < 1 - 41 .or. k > p) then
-          print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
+          ! print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
           error stop
         end if
       end do
@@ -102,25 +99,25 @@ subroutine lastprivate_check_simd_1
 
   ! Same but 'private' for all (i,j) vars
 
-!  !$omp simd collapse(3) lastprivate(k) private(i,j)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-!
-!  !$omp simd collapse(3) lastprivate(k) private(i,j)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
+  !$omp simd collapse(3) lastprivate(k) private(i,j)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+
+  !$omp simd collapse(3) lastprivate(k) private(i,j)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
 
   !$omp simd collapse(3) lastprivate(k) private(i,j)
   do i = 1, n, 2
@@ -144,27 +141,27 @@ subroutine lastprivate_check_simd_1
 
   ! Same - but with lastprivate(i,j)
 
-!  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-!  if (i /= n + 1 .or. j /= m + 2) error stop
-
-!  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-!  if (i /= n + 2 .or. j /= m + 1) error stop
+  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+  if (i /= n + 1 .or. j /= m + 2) error stop
+
+  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+  if (i /= n + 2 .or. j /= m + 1) error stop
 
   !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
   do i = 1, n, 2
@@ -201,25 +198,25 @@ subroutine lastprivate_check_do_simd_1
   ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
   ! Then same, except use non-unit step for 'k'
 
-!  !$omp parallel do simd collapse(3) lastprivate(k)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-
-!  !$omp parallel do simd collapse(3) lastprivate(k)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
+  !$omp parallel do simd collapse(3) lastprivate(k)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+
+  !$omp parallel do simd collapse(3) lastprivate(k)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
 
   !$omp parallel do simd collapse(3) lastprivate(k)
   do i = 1, n, 2
@@ -243,25 +240,25 @@ subroutine lastprivate_check_do_simd_1
 
   ! Same but 'private' for all (i,j) vars
 
-!  !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-
-!  !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
+  !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+
+  !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
 
   !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
   do i = 1, n, 2
@@ -285,27 +282,27 @@ subroutine lastprivate_check_do_simd_1
 
   ! Same - but with lastprivate(i,j)
 
-!  !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-!  if (i /= n + 1 .or. j /= m + 2) error stop
-
-!  !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-!  if (i /= n + 2 .or. j /= m + 1) error stop
+  !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+  if (i /= n + 1 .or. j /= m + 2) error stop
+
+  !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+  if (i /= n + 2 .or. j /= m + 1) error stop
 
   !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
   do i = 1, n, 2
@@ -343,25 +340,25 @@ subroutine lastprivate_check_do_1
   ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
   ! Then same, except use non-unit step for 'k'
 
-!  !$omp parallel do collapse(3) lastprivate(k)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-
-!  !$omp parallel do collapse(3) lastprivate(k)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
+  !$omp parallel do collapse(3) lastprivate(k)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+
+  !$omp parallel do collapse(3) lastprivate(k)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
 
   !$omp parallel do collapse(3) lastprivate(k)
   do i = 1, n, 2
@@ -385,25 +382,25 @@ subroutine lastprivate_check_do_1
 
   ! Same but 'private' for all (i,j) vars
 
-!  !$omp parallel do collapse(3) lastprivate(k) private(i,j)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-
-!  !$omp parallel do collapse(3) lastprivate(k) private(i,j)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
+  !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+  do i = 1, n
+    do j = 1, m, 2
+      do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+
+  !$omp parallel do collapse(3) lastprivate(k) private(i,j)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
 
   !$omp parallel do collapse(3) lastprivate(k) private(i,j)
   do i = 1, n, 2
@@ -427,27 +424,27 @@ subroutine lastprivate_check_do_1
 
   ! Same - but with lastprivate(i,j)
 
-!  !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
-!  do i = 1, n
-!    do j = 1, m, 2
-!      do k = j - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-!  if (i /= n + 1 .or. j /= m + 2) error stop
-
-!  !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
-!  do i = 1, n, 2
-!    do j = 1, m
-!      do k = i - 41, p
-!        if (k < 1 - 41 .or. k > p) error stop
-!      end do
-!    end do
-!  end do
-!  if (k /= p + 1) error stop
-!  if (i /= n + 2 .or. j /= m + 1) error stop
+  !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = 1, n
+    do j = 1, m, 2
+     do k = j - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+  if (i /= n + 1 .or. j /= m + 2) error stop
+
+  !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = 1, n, 2
+    do j = 1, m
+      do k = i - 41, p
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= p + 1) error stop
+  if (i /= n + 2 .or. j /= m + 1) error stop
 
   !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
   do i = 1, n, 2
@@ -481,42 +478,42 @@ subroutine lastprivate_check_2
   m = 23
   p = 27
 
-!  !$omp parallel do simd collapse(3) lastprivate(p)
-!  do i = 1, n
-!    do j = 1, m,2
-!      do k = 1, j + 41
-!        do ll = 1, p, 2
-!          if (k > 23 + 41 .or. k < 1) error stop
-!        end do
-!      end do
-!    end do
-!  end do
-!  if (ll /= 29) error stop
-
-!  !$omp simd collapse(3) lastprivate(p)
-!  do i = 1, n
-!    do j = 1, m,2
-!      do k = 1, j + 41
-!        do ll = 1, p, 2
-!          if (k > 23 + 41 .or. k < 1) error stop
-!        end do
-!      end do
-!    end do
-!  end do
-!  if (ll /= 29) error stop
-
-!  !$omp simd collapse(3) lastprivate(k)
-!  do i = 1, n,2
-!    do j = 1, m
-!      do k = 1, i + 41
-!        if (k > 11 + 41 .or. k < 1) error stop
-!      end do
-!    end do
-!  end do
-!if (k /= 53) then
-!  print *, k, 53
-!  error stop
-!endif
+  !$omp parallel do simd collapse(3) lastprivate(ll)
+  do i = 1, n
+    do j = 1, m,2
+      do k = 1, j + 41
+        do ll = 1, p, 2
+          if (k > 23 + 41 .or. k < 1) error stop
+        end do
+      end do
+    end do
+  end do
+  if (ll /= 29) error stop
+
+  !$omp simd collapse(3) lastprivate(ll)
+  do i = 1, n
+    do j = 1, m,2
+      do k = 1, j + 41
+        do ll = 1, p, 2
+          if (k > 23 + 41 .or. k < 1) error stop
+        end do
+      end do
+    end do
+  end do
+  if (ll /= 29) error stop
+
+  !$omp simd collapse(3) lastprivate(k)
+  do i = 1, n,2
+    do j = 1, m
+      do k = 1, i + 41
+        if (k > 11 + 41 .or. k < 1) error stop
+      end do
+    end do
+  end do
+if (k /= 53) then
+  print *, k, 53
+  error stop
+endif
 
 !$omp simd collapse(3) lastprivate(k)
 do i = 1, n,2
@@ -546,32 +543,32 @@ if (k /= 53) then
 endif
 
 ! - Same but without 'private':
-!!$omp simd collapse(3) lastprivate(k)
-!do i = 1, n
-!  do j = 1, m,2
-!    do k = 1, j + 41
-!      if (k > 23 + 41 .or. k < 1) error stop
-!    end do
-!  end do
-!end do
-!if (k /= 65) then
-!  print *, k, 65
-!  error stop
-!endif
-
-
-!!$omp simd collapse(3) lastprivate(k)
-!do i = 1, n,2
-!  do j = 1, m
-!    do k = 1, i + 41
-!      if (k > 11 + 41 .or. k < 1) error stop
-!    end do
-!  end do
-!end do
-!if (k /= 53) then
-!  print *, k, 53
-!  error stop
-!endif
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n
+  do j = 1, m,2
+    do k = 1, j + 41
+      if (k > 23 + 41 .or. k < 1) error stop
+    end do
+  end do
+end do
+if (k /= 65) then
+  print *, k, 65
+  error stop
+endif
+
+
+!$omp simd collapse(3) lastprivate(k)
+do i = 1, n,2
+  do j = 1, m
+    do k = 1, i + 41
+      if (k > 11 + 41 .or. k < 1) error stop
+    end do
+  end do
+end do
+if (k /= 53) then
+  print *, k, 53
+  error stop
+endif
 
 !$omp simd collapse(3) lastprivate(k)
 do i = 1, n,2
@@ -601,32 +598,32 @@ if (k /= 53) then
 endif
 
 ! - all with lastprivate
-!!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
-!do i = 1, n
-!  do j = 1, m,2
-!    do k = 1, j + 41
-!      if (k > 23 + 41 .or. k < 1) error stop
-!    end do
-!  end do
-!end do
-!if (k /= 65) then
-!  print *, k, 65
-!  error stop
-!endif
-
-
-!!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
-!do i = 1, n,2
-!  do j = 1, m
-!    do k = 1, i + 41
-!      if (k > 11 + 41 .or. k < 1) error stop
-!    end do
-!  end do
-!end do
-!if (k /= 53) then
-!  print *, k, 53
-!  error stop
-!endif
+!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+do i = 1, n
+  do j = 1, m,2
+    do k = 1, j + 41
+      if (k > 23 + 41 .or. k < 1) error stop
+    end do
+  end do
+end do
+if (k /= 65) then
+  print *, k, 65
+  error stop
+endif
+
+
+!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
+do i = 1, n,2
+  do j = 1, m
+    do k = 1, i + 41
+      if (k > 11 + 41 .or. k < 1) error stop
+    end do
+  end do
+end do
+if (k /= 53) then
+  print *, k, 53
+  error stop
+endif
 
 !$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
 do i = 1, n,2

diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1a.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1a.f90
deleted file mode 100644 (file)
index 77aa887..0000000
--- a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1a.f90
+++ /dev/null
@@ -1,374 +0,0 @@
-! { dg-do compile }
-! { dg-additional-options "-msse2" { target sse2_runtime } }
-! { dg-additional-options "-mavx" { target avx_runtime } }
-
-! PR fortran/107424
-
-! Nonrectangular loop nests checks
-
-! ========================================================
-! NOTE: The testcases are from non-rectangular-loop-1.f90,
-! but commented there. Feel free to remove this
-! file + uncomment them in non-rectangular-loop-1.f90
-! Otherwise, you need to change it to 'dg-do run'!
-! ========================================================
-
-module m
-  implicit none (type, external)
-contains
-
-! The 'k' loop uses i or j as start value
-! but a constant end value such that 'lastprivate'
-! should be well-defined
-subroutine lastprivate_check_simd_1
-  integer :: n,m,p, i,j,k
-
-  n = 11
-  m = 23
-  p = 27
-
-  ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
-  ! Then same, except use non-unit step for 'k'
-
-  !$omp simd collapse(3) lastprivate(k)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  !$omp simd collapse(3) lastprivate(k)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  ! Same but 'private' for all (i,j) vars
-
-  !$omp simd collapse(3) lastprivate(k) private(i,j)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  !$omp simd collapse(3) lastprivate(k) private(i,j)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  ! Same - but with lastprivate(i,j)
-
-  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-  if (i /= n + 1 .or. j /= m + 2) error stop
-
-  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-  if (i /= n + 2 .or. j /= m + 1) error stop
-
-end subroutine lastprivate_check_simd_1
-
-
-! Same but with do simd
-subroutine lastprivate_check_do_simd_1
-  integer :: n,m,p, i,j,k
-
-  n = 11
-  m = 23
-  p = 27
-
-  ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
-  ! Then same, except use non-unit step for 'k'
-
-  !$omp parallel do simd collapse(3) lastprivate(k)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  !$omp parallel do simd collapse(3) lastprivate(k)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  ! Same but 'private' for all (i,j) vars
-
-  !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  !$omp parallel do simd collapse(3) lastprivate(k) private(i,j)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  ! Same - but with lastprivate(i,j)
-
-  !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-  if (i /= n + 1 .or. j /= m + 2) error stop
-
-  !$omp parallel do simd collapse(3) lastprivate(k) lastprivate(i,j)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-  if (i /= n + 2 .or. j /= m + 1) error stop
-
-end subroutine lastprivate_check_do_simd_1
-
-
-
-! Same but with do
-subroutine lastprivate_check_do_1
-  integer :: n,m,p, i,j,k
-
-  n = 11
-  m = 23
-  p = 27
-
-  ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
-  ! Then same, except use non-unit step for 'k'
-
-  !$omp parallel do collapse(3) lastprivate(k)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  !$omp parallel do collapse(3) lastprivate(k)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  ! Same but 'private' for all (i,j) vars
-
-  !$omp parallel do collapse(3) lastprivate(k) private(i,j)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  !$omp parallel do collapse(3) lastprivate(k) private(i,j)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-
-  ! Same - but with lastprivate(i,j)
-
-  !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
-  do i = 1, n
-    do j = 1, m, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = j - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-  if (i /= n + 1 .or. j /= m + 2) error stop
-
-  !$omp parallel do collapse(3) lastprivate(k) lastprivate(i,j)
-  do i = 1, n, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = i - 41, p  ! { dg-note "Used here" }
-        if (k < 1 - 41 .or. k > p) error stop
-      end do
-    end do
-  end do
-  if (k /= p + 1) error stop
-  if (i /= n + 2 .or. j /= m + 1) error stop
-
-end subroutine lastprivate_check_do_1
-
-
-
-subroutine lastprivate_check_2
-  integer :: n,m,p, i,j,k,ll
-
-  n = 11
-  m = 23
-  p = 27
-
-  !$omp parallel do simd collapse(3) lastprivate(p)
-  do i = 1, n
-    do j = 1, m,2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = 1, j + 41  ! { dg-note "Used here" }
-        do ll = 1, p, 2
-          if (k > 23 + 41 .or. k < 1) error stop
-        end do
-      end do
-    end do
-  end do
-  if (ll /= 29) error stop
-
-  !$omp simd collapse(3) lastprivate(p)
-  do i = 1, n
-    do j = 1, m,2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-      do k = 1, j + 41  ! { dg-note "Used here" }
-        do ll = 1, p, 2
-          if (k > 23 + 41 .or. k < 1) error stop
-        end do
-      end do
-    end do
-  end do
-  if (ll /= 29) error stop
-
-  !$omp simd collapse(3) lastprivate(k)
-  do i = 1, n,2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-    do j = 1, m
-      do k = 1, i + 41  ! { dg-note "Used here" }
-        if (k > 11 + 41 .or. k < 1) error stop
-      end do
-    end do
-  end do
-if (k /= 53) then
-  print *, k, 53
-  error stop
-endif
-
-! - Same but without 'private':
-!$omp simd collapse(3) lastprivate(k)
-do i = 1, n
-  do j = 1, m,2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-    do k = 1, j + 41  ! { dg-note "Used here" }
-      if (k > 23 + 41 .or. k < 1) error stop
-    end do
-  end do
-end do
-if (k /= 65) then
-  print *, k, 65
-  error stop
-endif
-
-
-!$omp simd collapse(3) lastprivate(k)
-do i = 1, n,2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-  do j = 1, m
-    do k = 1, i + 41  ! { dg-note "Used here" }
-      if (k > 11 + 41 .or. k < 1) error stop
-    end do
-  end do
-end do
-if (k /= 53) then
-  print *, k, 53
-  error stop
-endif
-
-! - all with lastprivate
-!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
-do i = 1, n
-  do j = 1, m,2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
-    do k = 1, j + 41  ! { dg-note "Used here" }
-      if (k > 23 + 41 .or. k < 1) error stop
-    end do
-  end do
-end do
-if (k /= 65) then
-  print *, k, 65
-  error stop
-endif
-
-
-!$omp simd collapse(3) lastprivate(k) lastprivate(i, j)
-do i = 1, n,2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'i'" }
-  do j = 1, m
-    do k = 1, i + 41  ! { dg-note "Used here" }
-      if (k > 11 + 41 .or. k < 1) error stop
-    end do
-  end do
-end do
-if (k /= 53) then
-  print *, k, 53
-  error stop
-endif
-
-end
-end module m
-
-program main
-  use m
-  implicit none (type, external)
-  call lastprivate_check_simd_1
-  call lastprivate_check_do_simd_1
-  call lastprivate_check_do_1
-  call lastprivate_check_2
-end

diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90
index 643ab796a84ce78c523b22793ed7b2bab534960c..0e251f263c887f200b32b64f2618c8381596c236 100644 (file)
--- a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90
@@ -2,27 +2,41 @@
 ! { dg-additional-options "-msse2" { target sse2_runtime } }
 ! { dg-additional-options "-mavx" { target avx_runtime } }
 
-! PR fortran/107424
+! PR fortran/107424 - original PR
+! PR fortran/110735 - PR to implement the feature below
 
 ! Nonrectangular loop nests checks
 
+integer :: step
+step = -1
 !$omp simd collapse(2)
 do i = 1, 10
-  do j = i, 10, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+  do j = i, 10, step  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with non-constant step for 'j'" }
   end do
 end do
 
+step = 3
 !$omp do collapse(2) lastprivate(j)  ! { dg-error "lastprivate variable 'j' is private in outer context" }
 do i = 1, 10
-  do j = i, 10, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+  do j = i, 10, step  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with non-constant step for 'j'" }
   end do
 end do
 if (i /= 11) stop 1
 
+step = -5
 !$omp simd collapse(2) lastprivate(j)
 do i = 1, 10
-  do j = i, 10, 2  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with step other than constant 1 or -1 for 'j'" }
+  do j = i, 10, step  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with non-constant step for 'j'" }
   end do
 end do
 if (i /= 11) stop 1
+
+step = -5
+!$omp simd collapse(2)
+do i = 1, 10, step  ! { dg-message "sorry, unimplemented: non-rectangular loop nest with non-constant step for 'i'" }
+  do j = i, i       ! { dg-note "Used here" }
+  end do
+end do
+if (i /= 11) stop 1
+
 end

diff --git a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-6.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-6.f90
new file mode 100644 (file)
index 0000000..ae885af
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-6.f90
@@ -0,0 +1,196 @@
+! { dg-do run }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+! PR fortran/107424
+
+! Nonrectangular loop nests checks
+! This testcase uses negative step sizes
+
+module m
+  implicit none (type, external)
+contains
+
+! The 'k' loop uses i or j as start value
+! but a constant end value such that 'lastprivate'
+! should be well-defined
+subroutine lastprivate_check_simd_1
+  integer :: n,m,p, i,j,k, one
+
+  n = 11
+  m = 23
+  p = 27
+  one = 1
+
+  ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
+  ! Then same, except use non-unit step for 'k'
+
+  !$omp simd collapse(3) lastprivate(k)
+  do i = n, one, -1
+    do j = m, one, -2
+      do k = p + j, p - 41, -1
+        if (k < p - 41 .or. k > p+m) error stop
+      end do
+    end do
+  end do
+  if (k /= p - 41 - 1) error stop
+
+  !$omp simd collapse(3) lastprivate(k)
+  do i = n, 1, -2
+    do j = m, 1, -1
+      do k = p, i - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+
+  !$omp simd collapse(3) lastprivate(k)
+  do i = n, one, -2
+    do j = m, one, -1
+      do k = p, j - 41, -1
+        if (k < 1 - 41 .or. k > p) then
+          ! print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
+          error stop
+        end if
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+
+  k = -43
+  m = 0
+  !$omp simd collapse(3) lastprivate(k)
+  do i = m, one, -2
+    do j = m, one, -1
+      do k = p, j - 41, -1
+        if (k < 1 - 41 .or. k > p) then
+          ! print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
+          error stop
+        end if
+      end do
+    end do
+  end do
+  if (k /= -43) error stop
+
+  m = 23
+
+  !$omp simd collapse(3) lastprivate(k)
+  do i = n, one, -1
+    do j = m, one, -2
+      do k = p, i - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+
+  n = -5
+  k = - 70
+  !$omp simd collapse(3) lastprivate(k)
+  do i = n, one, -1
+    do j = m, one, -2
+      do k = p, i - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -70) error stop
+
+  n = 11
+
+  ! Same but 'private' for all (i,j) vars
+
+  !$omp simd collapse(3) lastprivate(k) private(i,j)
+  do i = n, one, -1
+    do j = m, one, -2
+      do k = p, j - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+
+  !$omp simd collapse(3) lastprivate(k) private(i,j)
+  do i = n, one, -2
+    do j = m, one, -1
+      do k = p, i - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+
+  !$omp simd collapse(3) lastprivate(k) private(i,j)
+  do i = n, one, -2
+    do j = m, one, -1
+      do k = p, j - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+
+  !$omp simd collapse(3) lastprivate(k) private(i,j)
+  do i = n, one, -1
+    do j = m, one, -2
+      do k = p, i - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+
+  ! Same - but with lastprivate(i,j)
+
+  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = n, one, -1
+    do j = m, one, -2
+      do k = p, j - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+  if (i /= 0 .or. j /= -1) error stop
+
+  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = n, 1, -2
+    do j = m, one, -1
+      do k = p, i - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+  if (i /= -1 .or. j /= 0) error stop
+
+  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = n, 1, -2
+    do j = m, 1, -1
+      do k = p, j - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+  if (i /= -1 .or. j /= 0) error stop
+
+  !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
+  do i = n, one, -1
+    do j = m, one, -2
+      do k = p, i - 41, -1
+        if (k < 1 - 41 .or. k > p) error stop
+      end do
+    end do
+  end do
+  if (k /= -41) error stop
+  if (i /= 0 .or. j /= -1) error stop
+end subroutine lastprivate_check_simd_1
+end module m
+
+program main
+  use m
+  implicit none (type, external)
+  call lastprivate_check_simd_1
+end