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) call abort
57  if (.not.allocated (foo)) call abort
58  if (size (foo).ne.18) call abort
59  if (any (foo.ne.1)) call abort
60
61  if (associated (bar1)) call abort
62  if (.not.associated (bar3)) call abort
63  if (any (bar3 .ne. -2)) call abort
64  deallocate (bar3)
65  if (associated (bar3)) call abort
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) call abort
89  if (.not.allocated (foo)) call abort
90  if (size (foo).ne.18) call abort
91  if (any (foo.ne.1)) call abort
92  deallocate (foo)
93  if (allocated (foo)) call abort
94end
95
96! { dg-final { cleanup-modules "threadprivate2" } }
97