1! { dg-additional-sources my-usleep.c }
2! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
3program main
4  implicit none
5  interface
6    subroutine usleep(t) bind(C, name="my_usleep")
7      use iso_c_binding
8      integer(c_int), value :: t
9    end subroutine
10  end interface
11
12  integer :: a(128)
13  integer :: i
14
15  !$omp parallel num_threads(8)
16    !$omp barrier
17    !$omp do schedule (dynamic, 2) order(reproducible:concurrent)
18    do i = 1, 128
19      a(i) = i
20      if (i == 1) then
21        call usleep (20)
22      else if (i == 18) then
23        call usleep (40)
24      end if
25    end do
26    !$omp end do nowait
27    !$omp do schedule (dynamic, 2) order(reproducible:concurrent)
28    do i = 1, 128
29      a(i) = a(i) + i
30    end do
31    !$omp end do nowait
32  !$omp end parallel
33  do i = 1, 128
34    if (a(i) /= 2 * i) &
35      stop
36  end do
37end program main
38