libgomp/testsuite/libgomp.fortran/omp_parse1.f90

   1 ! { dg-do run }
   2 use omp_lib
   3   call test_parallel
   4   call test_do
   5   call test_sections
   6   call test_single
   7
   8 contains
   9   subroutine test_parallel
  10     integer :: a, b, c, e, f, g, i, j
  11     integer, dimension (20) :: d
  12     logical :: h
  13     a = 6
  14     b = 8
  15     c = 11
  16     d(:) = -1
  17     e = 13
  18     f = 24
  19     g = 27
  20     h = .false.
  21     i = 1
  22     j = 16
  23 !$omp para&
  24 !$omp&llel &
  25 !$omp if (a .eq. 6) private (b, c) shared (d) private (e) &
  26   !$omp firstprivate(f) num_threads (a - 1) first&
  27 !$ompprivate(g)default (shared) reduction (.or. : h) &
  28 !$omp reduction(*:i)
  29     if (i .ne. 1) h = .true.
  30     i = 2
  31     if (f .ne. 24) h = .true.
  32     if (g .ne. 27) h = .true.
  33     e = 7
  34     b = omp_get_thread_num ()
  35     if (b .eq. 0) j = 24
  36     f = b
  37     g = f
  38     c = omp_get_num_threads ()
  39     if (c .gt. a - 1 .or. c .le. 0) h = .true.
  40     if (b .ge. c) h = .true.
  41     d(b + 1) = c
  42     if (f .ne. g .or. f .ne. b) h = .true.
  43 !$omp endparallel
  44     if (h) call abort
  45     if (a .ne. 6) call abort
  46     if (j .ne. 24) call abort
  47     if (d(1) .eq. -1) call abort
  48     e = 1
  49     do g = 1, d(1)
  50       if (d(g) .ne. d(1)) call abort
  51       e = e * 2
  52     end do
  53     if (e .ne. i) call abort
  54   end subroutine test_parallel
  55
  56   subroutine test_do_orphan
  57     integer :: k, l
  58 !$omp parallel do private (l)
  59     do 600 k = 1, 16, 2
  60 600   l = k
  61   end subroutine test_do_orphan
  62
  63   subroutine test_do
  64     integer :: i, j, k, l, n
  65     integer, dimension (64) :: d
  66     logical :: m
  67
  68     j = 16
  69     d(:) = -1
  70     m = .true.
  71     n = 24
  72 !$omp parallel num_threads (4) shared (i, k, d) private (l) &
  73 !$omp&reduction (.and. : m)
  74     if (omp_get_thread_num () .eq. 0) then
  75       k = omp_get_num_threads ()
  76     end if
  77     call test_do_orphan
  78 !$omp do schedule (static) firstprivate (n)
  79     do 200 i = 1, j
  80       if (i .eq. 1 .and. n .ne. 24) call abort
  81       n = i
  82 200   d(n) = omp_get_thread_num ()
  83 !$omp enddo nowait
  84
  85 !$omp do lastprivate (i) schedule (static, 5)
  86     do 201 i = j + 1, 2 * j
  87 201   d(i) = omp_get_thread_num () + 1024
  88     ! Implied omp end do here
  89
  90     if (i .ne. 33) m = .false.
  91
  92 !$omp do private (j) schedule (dynamic)
  93     do i = 33, 48
  94       d(i) = omp_get_thread_num () + 2048
  95     end do
  96 !$omp end do nowait
  97
  98 !$omp do schedule (runtime)
  99     do i = 49, 4 * j
 100       d(i) = omp_get_thread_num () + 4096
 101     end do
 102     ! Implied omp end do here
 103 !$omp end parallel
 104     if (.not. m) call abort
 105
 106     j = 0
 107     do i = 1, 64
 108       if (d(i) .lt. j .or. d(i) .ge. j + k) call abort
 109       if (i .eq. 16) j = 1024
 110       if (i .eq. 32) j = 2048
 111       if (i .eq. 48) j = 4096
 112     end do
 113   end subroutine test_do
 114
 115   subroutine test_sections
 116     integer :: i, j, k, l, m, n
 117     i = 9
 118     j = 10
 119     k = 11
 120     l = 0
 121     m = 0
 122     n = 30
 123     call omp_set_dynamic (.false.)
 124     call omp_set_num_threads (4)
 125 !$omp parallel num_threads (4)
 126 !$omp sections private (i) firstprivate (j, k) lastprivate (j) &
 127 !$omp& reduction (+ : l, m)
 128 !$omp section
 129     i = 24
 130     if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1
 131     m = m + 4
 132 !$omp section
 133     i = 25
 134     if (j .ne. 10 .or. k .ne. 11) l = 1
 135     m = m + 6
 136 !$omp section
 137     i = 26
 138     if (j .ne. 10 .or. k .ne. 11) l = 1
 139     m = m + 8
 140 !$omp section
 141     i = 27
 142     if (j .ne. 10 .or. k .ne. 11) l = 1
 143     m = m + 10
 144     j = 271
 145 !$omp end sections nowait
 146 !$omp sections lastprivate (n)
 147 !$omp section
 148     n = 6
 149 !$omp section
 150     n = 7
 151 !$omp endsections
 152 !$omp end parallel
 153     if (j .ne. 271 .or. l .ne. 0) call abort
 154     if (m .ne. 4 + 6 + 8 + 10) call abort
 155     if (n .ne. 7) call abort
 156   end subroutine test_sections
 157
 158   subroutine test_single
 159     integer :: i, j, k, l
 160     logical :: m
 161     i = 200
 162     j = 300
 163     k = 400
 164     l = 500
 165     m = .false.
 166 !$omp parallel num_threads (4), private (i, j), reduction (.or. : m)
 167     i = omp_get_thread_num ()
 168     j = omp_get_thread_num ()
 169 !$omp single private (k)
 170     k = 64
 171 !$omp end single nowait
 172 !$omp single private (k) firstprivate (l)
 173     if (i .ne. omp_get_thread_num () .or. i .ne. j) then
 174       j = -1
 175     else
 176       j = -2
 177     end if
 178     if (l .ne. 500) j = -1
 179     l = 265
 180 !$omp end single copyprivate (j)
 181     if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true.
 182 !$omp endparallel
 183     if (m) call abort
 184   end subroutine test_single
 185 end