1! { dg-options "-std=legacy" }
2
3  integer :: err
4  err = 0
5!$omp parallel num_threads (4) default (none) shared (err)
6!$omp single
7  call test
8!$omp end single
9!$omp end parallel
10  if (err.ne.0) STOP 1
11contains
12  subroutine check (x, y, l)
13    integer :: x, y
14    logical :: l
15    l = l .or. x .ne. y
16  end subroutine check
17
18  subroutine foo (c, d, e, f, g, h, i, j, k, n)
19    use omp_lib
20    integer :: n
21    character (len = *) :: c
22    character (len = n) :: d
23    integer, dimension (2, 3:5, n) :: e
24    integer, dimension (2, 3:n, n) :: f
25    character (len = *), dimension (5, 3:n) :: g
26    character (len = n), dimension (5, 3:n) :: h
27    real, dimension (:, :, :) :: i
28    double precision, dimension (3:, 5:, 7:) :: j
29    integer, dimension (:, :, :) :: k
30    logical :: l
31    integer :: p, q, r
32    character (len = n) :: s
33    integer, dimension (2, 3:5, n) :: t
34    integer, dimension (2, 3:n, n) :: u
35    character (len = n), dimension (5, 3:n) :: v
36    character (len = 2 * n + 24) :: w
37    integer :: x, z
38    character (len = 1) :: y
39    s = 'PQRSTUV'
40    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
41    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
42    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
43    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
44!$omp task default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
45!$omp & firstprivate (s, t, u, v) private (l, p, q, r, w, x, y) shared (err)
46    l = .false.
47    l = l .or. c .ne. 'abcdefghijkl'
48    l = l .or. d .ne. 'ABCDEFG'
49    l = l .or. s .ne. 'PQRSTUV'
50    do 100, p = 1, 2
51      do 100, q = 3, 7
52	do 100, r = 1, 7
53	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
54	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
55	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
56	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
57	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
58	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
59	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
60	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
61	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
62	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
63100 continue
64    do 101, p = 3, 5
65      do 101, q = 2, 6
66	do 101, r = 1, 7
67	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
68	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
69101 continue
70    do 102, p = 1, 5
71      do 102, q = 4, 6
72	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
73102 continue
74    call check (size (e, 1), 2, l)
75    call check (size (e, 2), 3, l)
76    call check (size (e, 3), 7, l)
77    call check (size (e), 42, l)
78    call check (size (f, 1), 2, l)
79    call check (size (f, 2), 5, l)
80    call check (size (f, 3), 7, l)
81    call check (size (f), 70, l)
82    call check (size (g, 1), 5, l)
83    call check (size (g, 2), 5, l)
84    call check (size (g), 25, l)
85    call check (size (h, 1), 5, l)
86    call check (size (h, 2), 5, l)
87    call check (size (h), 25, l)
88    call check (size (i, 1), 3, l)
89    call check (size (i, 2), 5, l)
90    call check (size (i, 3), 7, l)
91    call check (size (i), 105, l)
92    call check (size (j, 1), 4, l)
93    call check (size (j, 2), 5, l)
94    call check (size (j, 3), 7, l)
95    call check (size (j), 140, l)
96    call check (size (k, 1), 5, l)
97    call check (size (k, 2), 1, l)
98    call check (size (k, 3), 3, l)
99    call check (size (k), 15, l)
100    if (l) then
101!$omp atomic
102      err = err + 1
103    end if
104!$omp end task
105  c = ''
106  d = ''
107  e(:, :, :) = 199
108  f(:, :, :) = 198
109  g(:, :) = ''
110  h(:, :) = ''
111  i(:, :, :) = 7.0
112  j(:, :, :) = 8.0
113  k(:, :, :) = 9
114  s = ''
115  t(:, :, :) = 10
116  u(:, :, :) = 11
117  v(:, :) = ''
118  end subroutine foo
119
120  subroutine test
121    character (len = 12) :: c
122    character (len = 7) :: d
123    integer, dimension (2, 3:5, 7) :: e
124    integer, dimension (2, 3:7, 7) :: f
125    character (len = 12), dimension (5, 3:7) :: g
126    character (len = 7), dimension (5, 3:7) :: h
127    real, dimension (3:5, 2:6, 1:7) :: i
128    double precision, dimension (3:6, 2:6, 1:7) :: j
129    integer, dimension (1:5, 7:7, 4:6) :: k
130    integer :: p, q, r
131    c = 'abcdefghijkl'
132    d = 'ABCDEFG'
133    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
134    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
135    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
136    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
137    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
138    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
139    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
140    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
141    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
142    call foo (c, d, e, f, g, h, i, j, k, 7)
143  end subroutine test
144end
145