libgomp/testsuite/libgomp.fortran/omp_parse2.f90

   1 ! { dg-do run }
   2 use omp_lib
   3   call test_master
   4   call test_critical
   5   call test_barrier
   6   call test_atomic
   7
   8 contains
   9   subroutine test_master
  10     logical :: i, j
  11     i = .false.
  12     j = .false.
  13 !$omp parallel num_threads (4)
  14 !$omp master
  15     i = .true.
  16     j = omp_get_thread_num () .eq. 0
  17 !$omp endmaster
  18 !$omp end parallel
  19     if (.not. (i .or. j)) call abort
  20   end subroutine test_master
  21
  22   subroutine test_critical_1 (i, j)
  23     integer :: i, j
  24 !$omp critical(critical_foo)
  25     i = i + 1
  26 !$omp end critical (critical_foo)
  27 !$omp critical
  28     j = j + 1
  29 !$omp end critical
  30     end subroutine test_critical_1
  31
  32   subroutine test_critical
  33     integer :: i, j, n
  34     n = -1
  35     i = 0
  36     j = 0
  37 !$omp parallel num_threads (4)
  38     if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads ()
  39     call test_critical_1 (i, j)
  40     call test_critical_1 (i, j)
  41 !$omp critical
  42     j = j + 1
  43 !$omp end critical
  44 !$omp critical (critical_foo)
  45     i = i + 1
  46 !$omp endcritical (critical_foo)
  47 !$omp end parallel
  48     if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort
  49   end subroutine test_critical
  50
  51   subroutine test_barrier
  52     integer :: i
  53     logical :: j
  54     i = 23
  55     j = .false.
  56 !$omp parallel num_threads (4)
  57     if (omp_get_thread_num () .eq. 0) i = 5
  58 !$omp flush (i)
  59 !$omp barrier
  60     if (i .ne. 5) then
  61 !$omp atomic
  62       j = j .or. .true.
  63     end if
  64 !$omp end parallel
  65     if (i .ne. 5 .or. j) call abort
  66   end subroutine test_barrier
  67
  68   subroutine test_atomic
  69     integer :: a, b, c, d, e, f, g
  70     a = 0
  71     b = 1
  72     c = 0
  73     d = 1024
  74     e = 1024
  75     f = -1
  76     g = -1
  77 !$omp parallel num_threads (8)
  78 !$omp atomic
  79     a = a + 2 + 4
  80 !$omp atomic
  81     b = 3 * b
  82 !$omp atomic
  83     c = 8 - c
  84 !$omp atomic
  85     d = d / 2
  86 !$omp atomic
  87     e = min (e, omp_get_thread_num ())
  88 !$omp atomic
  89     f = max (omp_get_thread_num (), f)
  90     if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads ()
  91 !$omp end parallel
  92     if (g .le. 0 .or. g .gt. 8) call abort
  93     if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort
  94     if (iand (g, 1) .eq. 1) then
  95       if (c .ne. 8) call abort
  96     else if (c .ne. 0) then
  97       call abort
  98     end if
  99     if (d .ne. 1024 / (2 ** g)) call abort
 100     if (e .ne. 0 .or. f .ne. g - 1) call abort
 101   end subroutine test_atomic
 102 end