Retro68/gcc/libgomp/testsuite/libgomp.fortran/vla5.f90

205 lines
7.9 KiB
Fortran
Raw Normal View History

2012-03-27 23:13:14 +00:00
! { dg-do run }
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
2014-09-21 17:33:12 +00:00
interface
subroutine GOMP_barrier () bind(c, name="GOMP_barrier")
end subroutine
end interface
2012-03-27 23:13:14 +00:00
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) lastprivate (c, d, e, f, g, h, i, j, k) &
!$omp & lastprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
!$omp private (p, q, r, w, x, y) schedule (static) shared (z2)
do 110 z = 0, omp_get_num_threads () - 1
if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
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)
2014-09-21 17:33:12 +00:00
call GOMP_barrier
2012-03-27 23:13:14 +00:00
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) call abort
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) call abort
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