libgomp/testsuite/libgomp.fortran/vla8.f90

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