Retro68/gcc/libgomp/testsuite/libgomp.fortran/vla4.f90
Wolfgang Thaller 6fbf4226da gcc-9.1
2019-06-20 20:10:10 +02:00

234 lines
9.0 KiB
Fortran

! { dg-do run }
! { dg-options "-std=legacy" }
call test
contains
subroutine check (x, y, l)
integer :: x, y
logical :: l
l = l .or. x .ne. y
end subroutine check
subroutine foo (c, d, e, f, g, h, i, j, k, n)
use omp_lib
interface
subroutine GOMP_barrier () bind(c, name="GOMP_barrier")
end subroutine
end interface
integer :: n
character (len = *) :: c
character (len = n) :: d
integer, dimension (2, 3:5, n) :: e
integer, dimension (2, 3:n, n) :: f
character (len = *), dimension (5, 3:n) :: g
character (len = n), dimension (5, 3:n) :: h
real, dimension (:, :, :) :: i
double precision, dimension (3:, 5:, 7:) :: j
integer, dimension (:, :, :) :: k
logical :: l
integer :: p, q, r
character (len = n) :: s
integer, dimension (2, 3:5, n) :: t
integer, dimension (2, 3:n, n) :: u
character (len = n), dimension (5, 3:n) :: v
character (len = 2 * n + 24) :: w
integer :: x, z, z2
character (len = 1) :: y
s = 'PQRSTUV'
forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
l = .false.
call omp_set_dynamic (.false.)
call omp_set_num_threads (6)
!$omp parallel do default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
!$omp private (p, q, r, w, x, y) schedule (static) shared (z2) &
!$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
do 110 z = 0, omp_get_num_threads () - 1
if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
l = l .or. c .ne. 'abcdefghijkl'
l = l .or. d .ne. 'ABCDEFG'
l = l .or. s .ne. 'PQRSTUV'
do 100, p = 1, 2
do 100, q = 3, 7
do 100, r = 1, 7
if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
100 continue
do 101, p = 3, 5
do 101, q = 2, 6
do 101, r = 1, 7
l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
101 continue
do 102, p = 1, 5
do 102, q = 4, 6
l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
102 continue
x = omp_get_thread_num ()
w = ''
if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
c = w(8:19)
d = w(1:7)
forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
s = w(20:26)
forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
call GOMP_barrier
y = ''
if (x .eq. 0) y = '0'
if (x .eq. 1) y = '1'
if (x .eq. 2) y = '2'
if (x .eq. 3) y = '3'
if (x .eq. 4) y = '4'
if (x .eq. 5) y = '5'
l = l .or. w(7:7) .ne. y
l = l .or. w(19:19) .ne. y
l = l .or. w(26:26) .ne. y
l = l .or. w(38:38) .ne. y
l = l .or. c .ne. w(8:19)
l = l .or. d .ne. w(1:7)
l = l .or. s .ne. w(20:26)
do 103, p = 1, 2
do 103, q = 3, 7
do 103, r = 1, 7
if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
103 continue
do 104, p = 3, 5
do 104, q = 2, 6
do 104, r = 1, 7
l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
104 continue
do 105, p = 1, 5
do 105, q = 4, 6
l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
105 continue
call check (size (e, 1), 2, l)
call check (size (e, 2), 3, l)
call check (size (e, 3), 7, l)
call check (size (e), 42, l)
call check (size (f, 1), 2, l)
call check (size (f, 2), 5, l)
call check (size (f, 3), 7, l)
call check (size (f), 70, l)
call check (size (g, 1), 5, l)
call check (size (g, 2), 5, l)
call check (size (g), 25, l)
call check (size (h, 1), 5, l)
call check (size (h, 2), 5, l)
call check (size (h), 25, l)
call check (size (i, 1), 3, l)
call check (size (i, 2), 5, l)
call check (size (i, 3), 7, l)
call check (size (i), 105, l)
call check (size (j, 1), 4, l)
call check (size (j, 2), 5, l)
call check (size (j, 3), 7, l)
call check (size (j), 140, l)
call check (size (k, 1), 5, l)
call check (size (k, 2), 1, l)
call check (size (k, 3), 3, l)
call check (size (k), 15, l)
110 continue
!$omp end parallel do
if (l) STOP 1
if (z2 == 6) then
x = 5
w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
y = '5'
l = l .or. w(7:7) .ne. y
l = l .or. w(19:19) .ne. y
l = l .or. w(26:26) .ne. y
l = l .or. w(38:38) .ne. y
l = l .or. c .ne. w(8:19)
l = l .or. d .ne. w(1:7)
l = l .or. s .ne. w(20:26)
do 113, p = 1, 2
do 113, q = 3, 7
do 113, r = 1, 7
if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
113 continue
do 114, p = 3, 5
do 114, q = 2, 6
do 114, r = 1, 7
l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
114 continue
do 115, p = 1, 5
do 115, q = 4, 6
l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
115 continue
if (l) STOP 2
end if
end subroutine foo
subroutine test
character (len = 12) :: c
character (len = 7) :: d
integer, dimension (2, 3:5, 7) :: e
integer, dimension (2, 3:7, 7) :: f
character (len = 12), dimension (5, 3:7) :: g
character (len = 7), dimension (5, 3:7) :: h
real, dimension (3:5, 2:6, 1:7) :: i
double precision, dimension (3:6, 2:6, 1:7) :: j
integer, dimension (1:5, 7:7, 4:6) :: k
integer :: p, q, r
c = 'abcdefghijkl'
d = 'ABCDEFG'
forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
call foo (c, d, e, f, g, h, i, j, k, 7)
end subroutine test
end