libgomp/testsuite/libgomp.fortran/threadprivate3.f90

   1 ! { dg-do run }
   2 ! { dg-require-effective-target tls_runtime }
   3
   4 module threadprivate3
   5   integer, dimension(:,:), pointer :: foo => NULL()
   6 !$omp threadprivate (foo)
   7 end module threadprivate3
   8
   9   use omp_lib
  10   use threadprivate3
  11
  12   integer, dimension(:), pointer :: bar1
  13   integer, dimension(2), target :: bar2, var
  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   var = 6
  32
  33 !$omp parallel num_threads (4) reduction (.or.:l)
  34   bar2 = omp_get_thread_num ()
  35   l = associated (bar3)
  36   bar1 => bar2
  37   l = l.or..not.associated (bar1)
  38   l = l.or..not.associated (bar1, bar2)
  39   l = l.or.any (bar1.ne.omp_get_thread_num ())
  40   nullify (bar1)
  41   l = l.or.associated (bar1)
  42   allocate (bar3 (4))
  43   l = l.or..not.associated (bar3)
  44   bar3 = omp_get_thread_num () - 2
  45   if (omp_get_thread_num () .ne. 0) then
  46     deallocate (bar3)
  47     if (associated (bar3)) STOP 1
  48   else
  49     bar1 => var
  50   end if
  51   bar2 = omp_get_thread_num () * 6 + 130
  52
  53   l = l.or.(baz%b.ne.32)
  54   baz%a = omp_get_thread_num () * 2
  55   baz%b = omp_get_thread_num () * 2 + 1
  56 !$omp end parallel
  57
  58   if (l) STOP 2
  59   if (.not.associated (bar1)) STOP 3
  60   if (any (bar1.ne.6)) STOP 4
  61   if (.not.associated (bar3)) STOP 5
  62   if (any (bar3 .ne. -2)) STOP 6
  63   deallocate (bar3)
  64   if (associated (bar3)) STOP 7
  65
  66   allocate (bar3 (10))
  67   bar3 = 17
  68
  69 !$omp parallel copyin (bar1, bar2, bar3, baz) num_threads (4) &
  70 !$omp& reduction (.or.:l)
  71   l = l.or..not.associated (bar1)
  72   l = l.or.any (bar1.ne.6)
  73   l = l.or.any (bar2.ne.130)
  74   l = l.or..not.associated (bar3)
  75   l = l.or.size (bar3).ne.10
  76   l = l.or.any (bar3.ne.17)
  77   allocate (bar1 (4))
  78   bar1 = omp_get_thread_num ()
  79   bar2 = omp_get_thread_num () + 8
  80
  81   l = l.or.(baz%a.ne.0)
  82   l = l.or.(baz%b.ne.1)
  83   baz%a = omp_get_thread_num () * 3 + 4
  84   baz%b = omp_get_thread_num () * 3 + 5
  85
  86 !$omp barrier
  87   if (omp_get_thread_num () .eq. 0) then
  88     deallocate (bar3)
  89   end if
  90   bar3 => bar2
  91 !$omp barrier
  92
  93   l = l.or..not.associated (bar1)
  94   l = l.or..not.associated (bar3)
  95   l = l.or.any (bar1.ne.omp_get_thread_num ())
  96   l = l.or.size (bar1).ne.4
  97   l = l.or.any (bar2.ne.omp_get_thread_num () + 8)
  98   l = l.or.any (bar3.ne.omp_get_thread_num () + 8)
  99   l = l.or.size (bar3).ne.2
 100
 101   l = l.or.(baz%a .ne. omp_get_thread_num () * 3 + 4)
 102   l = l.or.(baz%b .ne. omp_get_thread_num () * 3 + 5)
 103 !$omp end parallel
 104
 105   if (l) STOP 8
 106 end
 107
 108 ! { dg-final { cleanup-modules "threadprivate3" } }