mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 12:00:11 -05:00
85da0b4053
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.
197 lines
4.3 KiB
Fortran
197 lines
4.3 KiB
Fortran
! { 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
|