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) call abort
  57   if (.not.allocated (foo)) call abort
  58   if (size (foo).ne.18) call abort
  59   if (any (foo.ne.1)) call abort
  60
  61   if (associated (bar1)) call abort
  62   if (.not.associated (bar3)) call abort
  63   if (any (bar3 .ne. -2)) call abort
  64   deallocate (bar3)
  65   if (associated (bar3)) call abort
  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) call abort
  89   if (.not.allocated (foo)) call abort
  90   if (size (foo).ne.18) call abort
  91   if (any (foo.ne.1)) call abort
  92   deallocate (foo)
  93   if (allocated (foo)) call abort
  94 end