libgomp/testsuite/libgomp.fortran/vla1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=legacy" }
   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
  32     character (len = 1) :: y
  33     s = 'PQRSTUV'
  34     forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
  35     forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
  36     forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
  37     forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
  38     l = .false.
  39 !$omp parallel default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
  40 !$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
  41 !$omp private (p, q, r, w, x, y)
  42     l = l .or. c .ne. 'abcdefghijkl'
  43     l = l .or. d .ne. 'ABCDEFG'
  44     l = l .or. s .ne. 'PQRSTUV'
  45     do 100, p = 1, 2
  46       do 100, q = 3, 7
  47         do 100, r = 1, 7
  48           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
  49           l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
  50           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
  51           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
  52           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
  53           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
  54           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
  55           l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
  56           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
  57           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
  58 100 continue
  59     do 101, p = 3, 5
  60       do 101, q = 2, 6
  61         do 101, r = 1, 7
  62           l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
  63           l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
  64 101 continue
  65     do 102, p = 1, 5
  66       do 102, q = 4, 6
  67         l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
  68 102 continue
  69     x = omp_get_thread_num ()
  70     w = ''
  71     if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
  72     if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
  73     if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
  74     if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
  75     if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
  76     if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
  77     c = w(8:19)
  78     d = w(1:7)
  79     forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
  80     forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
  81     forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
  82     forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
  83     forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
  84     forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
  85     forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
  86     forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
  87     forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
  88     s = w(20:26)
  89     forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
  90     forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
  91     forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
  92     forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
  93 !$omp barrier
  94     y = ''
  95     if (x .eq. 0) y = '0'
  96     if (x .eq. 1) y = '1'
  97     if (x .eq. 2) y = '2'
  98     if (x .eq. 3) y = '3'
  99     if (x .eq. 4) y = '4'
 100     if (x .eq. 5) y = '5'
 101     l = l .or. w(7:7) .ne. y
 102     l = l .or. w(19:19) .ne. y
 103     l = l .or. w(26:26) .ne. y
 104     l = l .or. w(38:38) .ne. y
 105     l = l .or. c .ne. w(8:19)
 106     l = l .or. d .ne. w(1:7)
 107     l = l .or. s .ne. w(20:26)
 108     do 103, p = 1, 2
 109       do 103, q = 3, 7
 110         do 103, r = 1, 7
 111           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
 112           l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
 113           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
 114           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
 115           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
 116           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
 117           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
 118           l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
 119           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
 120           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
 121 103 continue
 122     do 104, p = 3, 5
 123       do 104, q = 2, 6
 124         do 104, r = 1, 7
 125           l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
 126           l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
 127 104 continue
 128     do 105, p = 1, 5
 129       do 105, q = 4, 6
 130         l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
 131 105 continue
 132     call check (size (e, 1), 2, l)
 133     call check (size (e, 2), 3, l)
 134     call check (size (e, 3), 7, l)
 135     call check (size (e), 42, l)
 136     call check (size (f, 1), 2, l)
 137     call check (size (f, 2), 5, l)
 138     call check (size (f, 3), 7, l)
 139     call check (size (f), 70, l)
 140     call check (size (g, 1), 5, l)
 141     call check (size (g, 2), 5, l)
 142     call check (size (g), 25, l)
 143     call check (size (h, 1), 5, l)
 144     call check (size (h, 2), 5, l)
 145     call check (size (h), 25, l)
 146     call check (size (i, 1), 3, l)
 147     call check (size (i, 2), 5, l)
 148     call check (size (i, 3), 7, l)
 149     call check (size (i), 105, l)
 150     call check (size (j, 1), 4, l)
 151     call check (size (j, 2), 5, l)
 152     call check (size (j, 3), 7, l)
 153     call check (size (j), 140, l)
 154     call check (size (k, 1), 5, l)
 155     call check (size (k, 2), 1, l)
 156     call check (size (k, 3), 3, l)
 157     call check (size (k), 15, l)
 158 !$omp end parallel
 159     if (l) STOP 1
 160   end subroutine foo
 161
 162   subroutine test
 163     character (len = 12) :: c
 164     character (len = 7) :: d
 165     integer, dimension (2, 3:5, 7) :: e
 166     integer, dimension (2, 3:7, 7) :: f
 167     character (len = 12), dimension (5, 3:7) :: g
 168     character (len = 7), dimension (5, 3:7) :: h
 169     real, dimension (3:5, 2:6, 1:7) :: i
 170     double precision, dimension (3:6, 2:6, 1:7) :: j
 171     integer, dimension (1:5, 7:7, 4:6) :: k
 172     integer :: p, q, r
 173     c = 'abcdefghijkl'
 174     d = 'ABCDEFG'
 175     forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
 176     forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
 177     forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
 178     forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
 179     forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
 180     forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
 181     forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
 182     forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
 183     forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
 184     call foo (c, d, e, f, g, h, i, j, k, 7)
 185   end subroutine test
 186 end