* [patch] OpenMP/Fortran: Non-rectangular loops with constant steps other than 1 or -1 [PR107424]
@ 2023-07-18 12:11 Tobias Burnus
2023-07-19 8:26 ` [committed] - " Tobias Burnus
0 siblings, 1 reply; 3+ messages in thread
From: Tobias Burnus @ 2023-07-18 12:11 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 853 bytes --]
Comments regarding the validity of the Fortran assumptions are welcome!
This patch now uses a 'simple' loop for OpenMP loops with
a constant loop-step size. Before, it only did so for step = ±1.
(Otherwise, a count variable is used from which the original
loop index variable is calculated from.)
For details, see the attached patch or
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=107424#c12
(comment 12 + 14 plus the email linked in comment 12).
Comments? Remarks? If there are none, I will relatively soonish
commit the attached patch to mainline, only.
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: non-rect-nonunit-step.diff --]
[-- Type: text/x-patch, Size: 39655 bytes --]
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:
* testsuite/libgomp.fortran/non-rectangular-loop-1.f90: Enabled
commented tests.
* testsuite/libgomp.fortran/non-rectangular-loop-1a.f90: Removed.
* 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.
gcc/fortran/trans-openmp.cc | 12 +-
gcc/testsuite/gfortran.dg/gomp/linear-2.f90 | 4 +-
.../libgomp.fortran/non-rectangular-loop-1.f90 | 537 ++++++++++-----------
.../libgomp.fortran/non-rectangular-loop-1a.f90 | 374 --------------
.../libgomp.fortran/non-rectangular-loop-5.f90 | 10 +-
.../libgomp.fortran/non-rectangular-loop-6.f90 | 196 ++++++++
6 files changed, 477 insertions(+), 656 deletions(-)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index c88ee3c7656..e33b18fdada 100644
--- 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/107424. */
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;
}
@@ -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 05f007fd5c2..88df96e9b8f 100644
--- 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/testsuite/libgomp.fortran/non-rectangular-loop-1.f90 b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-1.f90
index dbbd18a1444..d074d4de5a0 100644
--- 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
index 77aa887942e..00000000000
--- 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 643ab796a84..82bc0b0a0c4 100644
--- a/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90
+++ b/libgomp/testsuite/libgomp.fortran/non-rectangular-loop-5.f90
@@ -6,22 +6,26 @@
! 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
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
index 00000000000..ae885af9623
--- /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
^ permalink raw reply [flat|nested] 3+ messages in thread
* [committed] - Re: [patch] OpenMP/Fortran: Non-rectangular loops with constant steps other than 1 or -1 [PR107424]
2023-07-18 12:11 [patch] OpenMP/Fortran: Non-rectangular loops with constant steps other than 1 or -1 [PR107424] Tobias Burnus
@ 2023-07-19 8:26 ` Tobias Burnus
2023-07-19 10:48 ` Thomas Schwinge
0 siblings, 1 reply; 3+ messages in thread
From: Tobias Burnus @ 2023-07-19 8:26 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1550 bytes --]
Now committed as Rev. r14-2634-g85da0b40538fb0
Changes:
* I missed to updated another 'sorry' (msg wording change) - now fixed;
I also added it to the sorry-testcase file non-rectangular-loop-5.f90.
* I decided to retire the PR as several issues have been fixed and the
original title did not fit any more. The remaining issue is now tracked
in PR110735 (i.e. handling step != const, both the generic and possibly
a simpler special case).
* I added a link to the PR to libgomp.texi such that one can find out
what is only partially supported for Fortran.
Thanks,
Tobias
PS: Otherwise, the following still applies:
On 18.07.23 14:11, Tobias Burnus wrote:
> Comments regarding the validity of the Fortran assumptions are welcome!
>
> This patch now uses a 'simple' loop for OpenMP loops with
> a constant loop-step size. Before, it only did so for step = ±1.
> (Otherwise, a count variable is used from which the original
> loop index variable is calculated from.)
>
> For details, see the attached patch or
> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=107424#c12
> (comment 12 + 14 plus the email linked in comment 12).
>
> Comments? Remarks? If there are none, I will relatively soonish
> commit the attached patch to mainline, only.
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: committed.diff --]
[-- Type: text/x-patch, Size: 42215 bytes --]
commit 85da0b40538fb0d17d89de1e7905984668e3dfef
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Wed Jul 19 10:18:49 2023 +0200
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.
---
gcc/fortran/trans-openmp.cc | 18 +-
gcc/testsuite/gfortran.dg/gomp/linear-2.f90 | 4 +-
libgomp/libgomp.texi | 4 +-
.../libgomp.fortran/non-rectangular-loop-1.f90 | 537 ++++++++++-----------
.../libgomp.fortran/non-rectangular-loop-1a.f90 | 374 --------------
.../libgomp.fortran/non-rectangular-loop-5.f90 | 22 +-
.../libgomp.fortran/non-rectangular-loop-6.f90 | 196 ++++++++
7 files changed, 494 insertions(+), 661 deletions(-)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index c88ee3c7656..cf741cebf91 100644
--- 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 05f007fd5c2..88df96e9b8f 100644
--- 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 639dd05eb7b..a8582b50177 100644
--- 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 dbbd18a1444..d074d4de5a0 100644
--- 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
index 77aa887942e..00000000000
--- 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 643ab796a84..0e251f263c8 100644
--- 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
index 00000000000..ae885af9623
--- /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
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [committed] - Re: [patch] OpenMP/Fortran: Non-rectangular loops with constant steps other than 1 or -1 [PR107424]
2023-07-19 8:26 ` [committed] - " Tobias Burnus
@ 2023-07-19 10:48 ` Thomas Schwinge
0 siblings, 0 replies; 3+ messages in thread
From: Thomas Schwinge @ 2023-07-19 10:48 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran, Jakub Jelinek, Frederik Harwath
Hi Tobias!
On 2023-07-19T10:26:12+0200, Tobias Burnus <tobias@codesourcery.com> wrote:
> Now committed as Rev. r14-2634-g85da0b40538fb0
On devel/omp/gcc-13 branch, the corresponding
commit b003e6511754dce475f7f5b0c5cd887a177e41b3
"OpenMP/Fortran: Non-rectangular loops with constant steps other than 1 or -1 [PR107424]"
introduces a regression:
PASS: libgomp.fortran/loop-transforms/unroll-2.f90 -O0 (test for excess errors)
[-PASS:-]{+FAIL:+} libgomp.fortran/loop-transforms/unroll-2.f90 -O0 execution test
Etc.
spawn [open ...]
4
8
10
11
Program aborted. Backtrace:
#0 0x400f9c in test
at [...]/libgomp.fortran/loop-transforms/unroll-2.f90:85
#1 0x400fd3 in main
at [...]/libgomp.fortran/loop-transforms/unroll-2.f90:59
Grüße
Thomas
> Changes:
>
> * I missed to updated another 'sorry' (msg wording change) - now fixed;
> I also added it to the sorry-testcase file non-rectangular-loop-5.f90.
>
> * I decided to retire the PR as several issues have been fixed and the
> original title did not fit any more. The remaining issue is now tracked
> in PR110735 (i.e. handling step != const, both the generic and possibly
> a simpler special case).
>
> * I added a link to the PR to libgomp.texi such that one can find out
> what is only partially supported for Fortran.
>
> Thanks,
>
> Tobias
>
> PS: Otherwise, the following still applies:
>
> On 18.07.23 14:11, Tobias Burnus wrote:
>> Comments regarding the validity of the Fortran assumptions are welcome!
>>
>> This patch now uses a 'simple' loop for OpenMP loops with
>> a constant loop-step size. Before, it only did so for step = ±1.
>> (Otherwise, a count variable is used from which the original
>> loop index variable is calculated from.)
>>
>> For details, see the attached patch or
>> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=107424#c12
>> (comment 12 + 14 plus the email linked in comment 12).
>>
>> Comments? Remarks? If there are none, I will relatively soonish
>> commit the attached patch to mainline, only.
> commit 85da0b40538fb0d17d89de1e7905984668e3dfef
> Author: Tobias Burnus <tobias@codesourcery.com>
> Date: Wed Jul 19 10:18:49 2023 +0200
>
> 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.
> ---
> gcc/fortran/trans-openmp.cc | 18 +-
> gcc/testsuite/gfortran.dg/gomp/linear-2.f90 | 4 +-
> libgomp/libgomp.texi | 4 +-
> .../libgomp.fortran/non-rectangular-loop-1.f90 | 537 ++++++++++-----------
> .../libgomp.fortran/non-rectangular-loop-1a.f90 | 374 --------------
> .../libgomp.fortran/non-rectangular-loop-5.f90 | 22 +-
> .../libgomp.fortran/non-rectangular-loop-6.f90 | 196 ++++++++
> 7 files changed, 494 insertions(+), 661 deletions(-)
>
> diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
> index c88ee3c7656..cf741cebf91 100644
> --- 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 05f007fd5c2..88df96e9b8f 100644
> --- 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 639dd05eb7b..a8582b50177 100644
> --- 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 dbbd18a1444..d074d4de5a0 100644
> --- 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
> index 77aa887942e..00000000000
> --- 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 643ab796a84..0e251f263c8 100644
> --- 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
> index 00000000000..ae885af9623
> --- /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
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2023-07-19 10:48 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-18 12:11 [patch] OpenMP/Fortran: Non-rectangular loops with constant steps other than 1 or -1 [PR107424] Tobias Burnus
2023-07-19 8:26 ` [committed] - " Tobias Burnus
2023-07-19 10:48 ` Thomas Schwinge
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).