libgomp/testsuite/libgomp.fortran/threadprivate4.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-std=f2003 -fall-intrinsics" }
   3 ! { dg-require-effective-target tls_runtime }
   4
   5 module threadprivate4
   6   integer :: vi
   7   procedure(), pointer :: foo
   8 !$omp threadprivate (foo, vi)
   9
  10 contains
  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
  23 end 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
  77 end
  78
  79 ! { dg-final { cleanup-modules "threadprivate4" } }