! { 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