libgomp/testsuite/libgomp.fortran/vla8.f90

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