libgomp/testsuite/libgomp.fortran/threadprivate2.f90

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