1! { dg-do run }
2! { dg-require-effective-target tls_runtime }
3  integer, pointer, save :: thr(:)
4!$omp threadprivate (thr)
5  integer, target :: s(3), t(3), u(3)
6  integer :: i
7  logical :: l
8  s = 2
9  t = 7
10  u = 13
11  thr => t
12  l = .false.
13  i = 0
14!$omp parallel copyin (thr) reduction(.or.:l) reduction(+:i)
15  if (any (thr.ne.7)) l = .true.
16  thr => s
17!$omp master
18  thr => u
19!$omp end master
20!$omp atomic
21  thr(1) = thr(1) + 1
22  i = i + 1
23!$omp end parallel
24  if (l) STOP 1
25  if (thr(1).ne.14) STOP 2
26  if (s(1).ne.1+i) STOP 3
27  if (u(1).ne.14) STOP 4
28end
29