1! { dg-do run }
2! { dg-require-effective-target tls_runtime }
3
4module threadprivate2
5  integer, dimension(:,:), allocatable :: foo
6!$omp threadprivate (foo)
7end module threadprivate2
8
9  use omp_lib
10  use threadprivate2
11
12  integer, dimension(:), pointer :: bar1
13  integer, dimension(2), target :: bar2
14  common /thrc/ bar1, bar2
15!$omp threadprivate (/thrc/)
16
17  integer, dimension(:), pointer, save :: bar3 => NULL()
18!$omp threadprivate (bar3)
19
20  logical :: l
21  type tt
22    integer :: a
23    integer :: b = 32
24  end type tt
25  type (tt), save :: baz
26!$omp threadprivate (baz)
27
28  l = .false.
29  call omp_set_dynamic (.false.)
30  call omp_set_num_threads (4)
31
32!$omp parallel num_threads (4) reduction (.or.:l)
33  l = allocated (foo)
34  allocate (foo (6 + omp_get_thread_num (), 3))
35  l = l.or..not.allocated (foo)
36  l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ())
37  foo = omp_get_thread_num () + 1
38
39  bar2 = omp_get_thread_num ()
40  l = l.or.associated (bar3)
41  bar1 => bar2
42  l = l.or..not.associated (bar1)
43  l = l.or..not.associated (bar1, bar2)
44  l = l.or.any (bar1.ne.omp_get_thread_num ())
45  nullify (bar1)
46  l = l.or.associated (bar1)
47  allocate (bar3 (4))
48  l = l.or..not.associated (bar3)
49  bar3 = omp_get_thread_num () - 2
50
51  l = l.or.(baz%b.ne.32)
52  baz%a = omp_get_thread_num () * 2
53  baz%b = omp_get_thread_num () * 2 + 1
54!$omp end parallel
55
56  if (l) STOP 1
57  if (.not.allocated (foo)) STOP 2
58  if (size (foo).ne.18) STOP 3
59  if (any (foo.ne.1)) STOP 4
60
61  if (associated (bar1)) STOP 5
62  if (.not.associated (bar3)) STOP 6
63  if (any (bar3 .ne. -2)) STOP 7
64  deallocate (bar3)
65  if (associated (bar3)) STOP 8
66
67!$omp parallel num_threads (4) reduction (.or.:l)
68  l = l.or..not.allocated (foo)
69  l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ())
70  l = l.or.any (foo.ne.(omp_get_thread_num () + 1))
71  if (omp_get_thread_num () .ne. 0) then
72    deallocate (foo)
73    l = l.or.allocated (foo)
74  end if
75
76  l = l.or.associated (bar1)
77  if (omp_get_thread_num () .ne. 0) then
78    l = l.or..not.associated (bar3)
79    l = l.or.any (bar3 .ne. omp_get_thread_num () - 2)
80    deallocate (bar3)
81  end if
82  l = l.or.associated (bar3)
83
84  l = l.or.(baz%a.ne.(omp_get_thread_num () * 2))
85  l = l.or.(baz%b.ne.(omp_get_thread_num () * 2 + 1))
86!$omp end parallel
87
88  if (l) STOP 9
89  if (.not.allocated (foo)) STOP 10
90  if (size (foo).ne.18) STOP 11
91  if (any (foo.ne.1)) STOP 12
92  deallocate (foo)
93  if (allocated (foo)) STOP 13
94end
95
96! { dg-final { cleanup-modules "threadprivate2" } }
97