libgomp/testsuite/libgomp.fortran/lib1.f90

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