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