libgomp/testsuite/libgomp.fortran/vla8.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=legacy" }
   3 ! { dg-timeout-factor 2.0 }
   4
   5   call test
   6 contains
   7   subroutine check (x, y, l)
   8     integer :: x, y
   9     logical :: l
  10     l = l .or. x .ne. y
  11   end subroutine check
  12
  13   subroutine foo (c, d, e, f, g, h, i, j, k, n)
  14     use omp_lib
  15     integer :: n
  16     character (len = *) :: c
  17     character (len = n) :: d
  18     integer, dimension (2, 3:5, n) :: e
  19     integer, dimension (2, 3:n, n) :: f
  20     character (len = *), dimension (5, 3:n) :: g
  21     character (len = n), dimension (5, 3:n) :: h
  22     real, dimension (:, :, :) :: i
  23     double precision, dimension (3:, 5:, 7:) :: j
  24     integer, dimension (:, :, :) :: k
  25     logical :: l
  26     integer :: p, q, r
  27     character (len = n) :: s
  28     integer, dimension (2, 3:5, n) :: t
  29     integer, dimension (2, 3:n, n) :: u
  30     character (len = n), dimension (5, 3:n) :: v
  31     character (len = 2 * n + 24) :: w
  32     integer :: x, z
  33     character (len = 1) :: y
  34     l = .false.
  35 !$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
  36 !$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
  37 !$omp private (p, q, r, w, x, y) shared (z)
  38     x = omp_get_thread_num ()
  39     w = ''
  40     if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
  41     if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
  42     if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
  43     if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
  44     if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
  45     if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
  46     c = w(8:19)
  47     d = w(1:7)
  48     forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
  49     forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
  50     forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
  51     forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
  52     forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
  53     forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
  54     forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
  55     forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
  56     forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
  57     s = w(20:26)
  58     forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
  59     forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
  60     forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
  61     forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
  62 !$omp barrier
  63     y = ''
  64     if (x .eq. 0) y = '0'
  65     if (x .eq. 1) y = '1'
  66     if (x .eq. 2) y = '2'
  67     if (x .eq. 3) y = '3'
  68     if (x .eq. 4) y = '4'
  69     if (x .eq. 5) y = '5'
  70     l = l .or. w(7:7) .ne. y
  71     l = l .or. w(19:19) .ne. y
  72     l = l .or. w(26:26) .ne. y
  73     l = l .or. w(38:38) .ne. y
  74     l = l .or. c .ne. w(8:19)
  75     l = l .or. d .ne. w(1:7)
  76     l = l .or. s .ne. w(20:26)
  77     do 103, p = 1, 2
  78       do 103, q = 3, 7
  79         do 103, r = 1, 7
  80           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
  81           l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
  82           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
  83           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
  84           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
  85           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
  86           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
  87           l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
  88           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
  89           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
  90 103 continue
  91     do 104, p = 3, 5
  92       do 104, q = 2, 6
  93         do 104, r = 1, 7
  94           l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
  95           l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
  96 104 continue
  97     do 105, p = 1, 5
  98       do 105, q = 4, 6
  99         l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
 100 105 continue
 101     call check (size (e, 1), 2, l)
 102     call check (size (e, 2), 3, l)
 103     call check (size (e, 3), 7, l)
 104     call check (size (e), 42, l)
 105     call check (size (f, 1), 2, l)
 106     call check (size (f, 2), 5, l)
 107     call check (size (f, 3), 7, l)
 108     call check (size (f), 70, l)
 109     call check (size (g, 1), 5, l)
 110     call check (size (g, 2), 5, l)
 111     call check (size (g), 25, l)
 112     call check (size (h, 1), 5, l)
 113     call check (size (h, 2), 5, l)
 114     call check (size (h), 25, l)
 115     call check (size (i, 1), 3, l)
 116     call check (size (i, 2), 5, l)
 117     call check (size (i, 3), 7, l)
 118     call check (size (i), 105, l)
 119     call check (size (j, 1), 4, l)
 120     call check (size (j, 2), 5, l)
 121     call check (size (j, 3), 7, l)
 122     call check (size (j), 140, l)
 123     call check (size (k, 1), 5, l)
 124     call check (size (k, 2), 1, l)
 125     call check (size (k, 3), 3, l)
 126     call check (size (k), 15, l)
 127 !$omp single
 128     z = omp_get_thread_num ()
 129 !$omp end single copyprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
 130     w = ''
 131     x = z
 132     if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
 133     if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
 134     if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
 135     if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
 136     if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
 137     if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
 138     y = ''
 139     if (x .eq. 0) y = '0'
 140     if (x .eq. 1) y = '1'
 141     if (x .eq. 2) y = '2'
 142     if (x .eq. 3) y = '3'
 143     if (x .eq. 4) y = '4'
 144     if (x .eq. 5) y = '5'
 145     l = l .or. w(7:7) .ne. y
 146     l = l .or. w(19:19) .ne. y
 147     l = l .or. w(26:26) .ne. y
 148     l = l .or. w(38:38) .ne. y
 149     l = l .or. c .ne. w(8:19)
 150     l = l .or. d .ne. w(1:7)
 151     l = l .or. s .ne. w(20:26)
 152     do 113, p = 1, 2
 153       do 113, q = 3, 7
 154         do 113, r = 1, 7
 155           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
 156           l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
 157           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
 158           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
 159           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
 160           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
 161           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
 162           l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
 163           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
 164           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
 165 113 continue
 166     do 114, p = 3, 5
 167       do 114, q = 2, 6
 168         do 114, r = 1, 7
 169           l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
 170           l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
 171 114 continue
 172     do 115, p = 1, 5
 173       do 115, q = 4, 6
 174         l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
 175 115 continue
 176     x = omp_get_thread_num ()
 177     w = ''
 178     if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
 179     if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
 180     if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
 181     if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
 182     if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
 183     if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
 184     c = w(8:19)
 185     d = w(1:7)
 186     forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
 187     forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
 188     forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
 189     forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
 190     forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
 191     forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
 192     forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
 193     forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
 194     forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
 195     s = w(20:26)
 196     forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
 197     forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
 198     forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
 199     forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
 200 !$omp barrier
 201     y = ''
 202     if (x .eq. 0) y = '0'
 203     if (x .eq. 1) y = '1'
 204     if (x .eq. 2) y = '2'
 205     if (x .eq. 3) y = '3'
 206     if (x .eq. 4) y = '4'
 207     if (x .eq. 5) y = '5'
 208     l = l .or. w(7:7) .ne. y
 209     l = l .or. w(19:19) .ne. y
 210     l = l .or. w(26:26) .ne. y
 211     l = l .or. w(38:38) .ne. y
 212     l = l .or. c .ne. w(8:19)
 213     l = l .or. d .ne. w(1:7)
 214     l = l .or. s .ne. w(20:26)
 215     do 123, p = 1, 2
 216       do 123, q = 3, 7
 217         do 123, r = 1, 7
 218           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
 219           l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
 220           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
 221           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
 222           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
 223           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
 224           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
 225           l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
 226           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
 227           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
 228 123 continue
 229     do 124, p = 3, 5
 230       do 124, q = 2, 6
 231         do 124, r = 1, 7
 232           l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
 233           l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
 234 124 continue
 235     do 125, p = 1, 5
 236       do 125, q = 4, 6
 237         l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
 238 125 continue
 239 !$omp end parallel
 240     if (l) STOP 1
 241   end subroutine foo
 242
 243   subroutine test
 244     character (len = 12) :: c
 245     character (len = 7) :: d
 246     integer, dimension (2, 3:5, 7) :: e
 247     integer, dimension (2, 3:7, 7) :: f
 248     character (len = 12), dimension (5, 3:7) :: g
 249     character (len = 7), dimension (5, 3:7) :: h
 250     real, dimension (3:5, 2:6, 1:7) :: i
 251     double precision, dimension (3:6, 2:6, 1:7) :: j
 252     integer, dimension (1:5, 7:7, 4:6) :: k
 253     integer :: p, q, r
 254     call foo (c, d, e, f, g, h, i, j, k, 7)
 255   end subroutine test
 256 end