libgomp/testsuite/libgomp.fortran/threadprivate4.f90

   1 ! { dg-do run }
   2 ! { dg-require-effective-target tls_runtime }
   3
   4 module threadprivate4
   5   integer :: vi
   6   procedure(), pointer :: foo
   7 !$omp threadprivate (foo, vi)
   8
   9 contains
  10   subroutine fn0
  11     vi = 0
  12   end subroutine fn0
  13   subroutine fn1
  14     vi = 1
  15   end subroutine fn1
  16   subroutine fn2
  17     vi = 2
  18   end subroutine fn2
  19   subroutine fn3
  20     vi = 3
  21   end subroutine fn3
  22 end module threadprivate4
  23
  24   use omp_lib
  25   use threadprivate4
  26
  27   integer :: i
  28   logical :: l
  29
  30   procedure(), pointer :: bar1
  31   common /thrc/ bar1
  32 !$omp threadprivate (/thrc/)
  33
  34   procedure(), pointer, save :: bar2
  35 !$omp threadprivate (bar2)
  36
  37   l = .false.
  38   call omp_set_dynamic (.false.)
  39   call omp_set_num_threads (4)
  40
  41 !$omp parallel num_threads (4) reduction (.or.:l) private (i)
  42   i = omp_get_thread_num ()
  43   if (i.eq.0) then
  44     foo => fn0
  45     bar1 => fn0
  46     bar2 => fn0
  47   elseif (i.eq.1) then
  48     foo => fn1
  49     bar1 => fn1
  50     bar2 => fn1
  51   elseif (i.eq.2) then
  52     foo => fn2
  53     bar1 => fn2
  54     bar2 => fn2
  55   else
  56     foo => fn3
  57     bar1 => fn3
  58     bar2 => fn3
  59   end if
  60   vi = -1
  61 !$omp barrier
  62   vi = -1
  63   call foo ()
  64   l=l.or.(vi.ne.i)
  65   vi = -2
  66   call bar1 ()
  67   l=l.or.(vi.ne.i)
  68   vi = -3
  69   call bar2 ()
  70   l=l.or.(vi.ne.i)
  71   vi = -1
  72 !$omp end parallel
  73
  74   if (l) call abort
  75
  76 end
  77
  78 ! { dg-final { cleanup-modules "threadprivate4" } }