libgomp/testsuite/libgomp.fortran/lib1.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-Wno-deprecated-declarations" }
   3
   4   use omp_lib
   5
   6   double precision :: d, e
   7   logical :: l
   8   integer (kind = omp_lock_kind) :: lck
   9   integer (kind = omp_nest_lock_kind) :: nlck
  10
  11   d = omp_get_wtime ()
  12
  13   call omp_init_lock (lck)
  14   call omp_set_lock (lck)
  15   if (omp_test_lock (lck)) stop 1
  16   call omp_unset_lock (lck)
  17   if (.not. omp_test_lock (lck)) stop 2
  18   if (omp_test_lock (lck)) stop 3
  19   call omp_unset_lock (lck)
  20   call omp_destroy_lock (lck)
  21
  22   call omp_init_nest_lock (nlck)
  23   if (omp_test_nest_lock (nlck) .ne. 1) stop 4
  24   call omp_set_nest_lock (nlck)
  25   if (omp_test_nest_lock (nlck) .ne. 3) stop 5
  26   call omp_unset_nest_lock (nlck)
  27   call omp_unset_nest_lock (nlck)
  28   if (omp_test_nest_lock (nlck) .ne. 2) stop 6
  29   call omp_unset_nest_lock (nlck)
  30   call omp_unset_nest_lock (nlck)
  31   call omp_destroy_nest_lock (nlck)
  32
  33   call omp_set_dynamic (.true.)
  34   if (.not. omp_get_dynamic ()) stop 7
  35   call omp_set_dynamic (.false.)
  36   if (omp_get_dynamic ()) stop 8
  37
  38   call omp_set_nested (.true.)
  39   if (.not. omp_get_nested ()) stop 9
  40   call omp_set_nested (.false.)
  41   if (omp_get_nested ()) stop 10
  42
  43   call omp_set_num_threads (5)
  44   if (omp_get_num_threads () .ne. 1) stop 11
  45   if (omp_get_max_threads () .ne. 5) stop 12
  46   if (omp_get_thread_num () .ne. 0) stop 13
  47   call omp_set_num_threads (3)
  48   if (omp_get_num_threads () .ne. 1) stop 14
  49   if (omp_get_max_threads () .ne. 3) stop 15
  50   if (omp_get_thread_num () .ne. 0) stop 16
  51   l = .false.
  52 !$omp parallel reduction (.or.:l)
  53   l = omp_get_num_threads () .ne. 3
  54   l = l .or. (omp_get_thread_num () .lt. 0)
  55   l = l .or. (omp_get_thread_num () .ge. 3)
  56 !$omp master
  57   l = l .or. (omp_get_thread_num () .ne. 0)
  58 !$omp end master
  59 !$omp end parallel
  60   if (l) stop 17
  61
  62   if (omp_get_num_procs () .le. 0) stop 18
  63   if (omp_in_parallel ()) stop 19
  64 !$omp parallel reduction (.or.:l)
  65   l = .not. omp_in_parallel ()
  66 !$omp end parallel
  67 !$omp parallel reduction (.or.:l) if (.true.)
  68   l = .not. omp_in_parallel ()
  69 !$omp end parallel
  70   if (l) stop 20
  71
  72   e = omp_get_wtime ()
  73   if (d .gt. e) stop 21
  74   d = omp_get_wtick ()
  75   ! Negative precision is definitely wrong,
  76   ! bigger than 1s clock resolution is also strange
  77   if (d .le. 0 .or. d .gt. 1.) stop 22
  78 end