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)) call abort
  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) call abort
  59   if (.not.associated (bar1)) call abort
  60   if (any (bar1.ne.6)) call abort
  61   if (.not.associated (bar3)) call abort
  62   if (any (bar3 .ne. -2)) call abort
  63   deallocate (bar3)
  64   if (associated (bar3)) call abort
  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) call abort
 106 end