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