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