1! { dg-do run }
2!$ use omp_lib
3
4  character (len = 8) :: h
5  character (len = 9) :: i
6  h = '01234567'
7  i = 'ABCDEFGHI'
8  call test (h, i, 9)
9contains
10  subroutine test (p, q, n)
11    character (len = *) :: p
12    character (len = n) :: q
13    character (len = n) :: r
14    character (len = n) :: t
15    character (len = n) :: u
16    integer, dimension (n + 4) :: s
17    logical :: l
18    integer :: m
19    r = ''
20    if (n .gt. 8) r = 'jklmnopqr'
21    do m = 1, n + 4
22      s(m) = m
23    end do
24    u = 'abc'
25    l = .false.
26!$omp parallel firstprivate (p, q, r) private (t, m) reduction (.or.:l) &
27!$omp & num_threads (2)
28    do m = 1, 13
29      if (s(m) .ne. m) l = .true.
30    end do
31    m = omp_get_thread_num ()
32    l = l .or. p .ne. '01234567' .or. q .ne. 'ABCDEFGHI'
33    l = l .or. r .ne. 'jklmnopqr' .or. u .ne. 'abc'
34!$omp barrier
35    if (m .eq. 0) then
36      p = 'A'
37      q = 'B'
38      r = 'C'
39      t = '123'
40      u = '987654321'
41    else if (m .eq. 1) then
42      p = 'D'
43      q = 'E'
44      r = 'F'
45      t = '456'
46      s = m
47    end if
48!$omp barrier
49    l = l .or. u .ne. '987654321'
50    if (any (s .ne. 1)) l = .true.
51    if (m .eq. 0) then
52      l = l .or. p .ne. 'A' .or. q .ne. 'B' .or. r .ne. 'C'
53      l = l .or. t .ne. '123'
54    else
55      l = l .or. p .ne. 'D' .or. q .ne. 'E' .or. r .ne. 'F'
56      l = l .or. t .ne. '456'
57    end if
58!$omp end parallel
59    if (l) call abort
60  end subroutine test
61end
62