libgomp/testsuite/libgomp.fortran/vla2.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     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)
  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 end parallel
 127     if (l) STOP 1
 128   end subroutine foo
 129
 130   subroutine test
 131     character (len = 12) :: c
 132     character (len = 7) :: d
 133     integer, dimension (2, 3:5, 7) :: e
 134     integer, dimension (2, 3:7, 7) :: f
 135     character (len = 12), dimension (5, 3:7) :: g
 136     character (len = 7), dimension (5, 3:7) :: h
 137     real, dimension (3:5, 2:6, 1:7) :: i
 138     double precision, dimension (3:6, 2:6, 1:7) :: j
 139     integer, dimension (1:5, 7:7, 4:6) :: k
 140     integer :: p, q, r
 141     call foo (c, d, e, f, g, h, i, j, k, 7)
 142   end subroutine test
 143 end