libgomp/testsuite/libgomp.fortran/omp_parse1.f90

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