1! { dg-do run }
2! { dg-additional-options "-std=f2003 -fall-intrinsics" }
3! { dg-require-effective-target tls_runtime }
4
5module threadprivate4
6  integer :: vi
7  procedure(), pointer :: foo
8!$omp threadprivate (foo, vi)
9
10contains
11  subroutine fn0
12    vi = 0
13  end subroutine fn0
14  subroutine fn1
15    vi = 1
16  end subroutine fn1
17  subroutine fn2
18    vi = 2
19  end subroutine fn2
20  subroutine fn3
21    vi = 3
22  end subroutine fn3
23end module threadprivate4
24
25  use omp_lib
26  use threadprivate4
27
28  integer :: i
29  logical :: l
30
31  procedure(), pointer :: bar1
32  common /thrc/ bar1
33!$omp threadprivate (/thrc/)
34
35  procedure(), pointer, save :: bar2
36!$omp threadprivate (bar2)
37
38  l = .false.
39  call omp_set_dynamic (.false.)
40  call omp_set_num_threads (4)
41
42!$omp parallel num_threads (4) reduction (.or.:l) private (i)
43  i = omp_get_thread_num ()
44  if (i.eq.0) then
45    foo => fn0
46    bar1 => fn0
47    bar2 => fn0
48  elseif (i.eq.1) then
49    foo => fn1
50    bar1 => fn1
51    bar2 => fn1
52  elseif (i.eq.2) then
53    foo => fn2
54    bar1 => fn2
55    bar2 => fn2
56  else
57    foo => fn3
58    bar1 => fn3
59    bar2 => fn3
60  end if
61  vi = -1
62!$omp barrier
63  vi = -1
64  call foo ()
65  l=l.or.(vi.ne.i)
66  vi = -2
67  call bar1 ()
68  l=l.or.(vi.ne.i)
69  vi = -3
70  call bar2 ()
71  l=l.or.(vi.ne.i)
72  vi = -1
73!$omp end parallel
74
75  if (l) stop 1
76
77end
78
79! { dg-final { cleanup-modules "threadprivate4" } }
80