1! { dg-do compile }
2! { dg-options "-O2 -fopenmp -fdump-tree-optimized" }
3! { dg-final { scan-tree-dump-times "__builtin_GOMP_loop_start \[^\n\r]*, (?:2147483651|-2147483645), 3, " 1 "optimized" } }
4! { dg-final { scan-tree-dump-times "__builtin_GOMP_loop_end " 1 "optimized" } }
5! { dg-final { scan-tree-dump-times "__builtin_GOMP_loop_guided_next " 1 "optimized" } }
6! { dg-final { scan-tree-dump-times "__builtin_GOMP_workshare_task_reduction_unregister \\(0\\)" 1 "optimized" } }
7! { dg-final { scan-tree-dump-times "__builtin_GOMP_parallel " 1 "optimized" } }
8
9module m
10  implicit none (type, external)
11  integer :: j
12  interface
13    subroutine bar(i)
14      integer :: i
15    end subroutine
16  end interface
17end module m
18
19subroutine foo(a, b, c)
20  use m
21  implicit none (type, external)
22  integer :: a, b ,c
23  integer :: i
24  !$omp parallel
25  !$omp do reduction (task, *: j) schedule (monotonic: guided, 3)
26  do i = a, b, c
27    j = j + 1
28    call bar (j)
29  end do
30  !$omp end parallel
31end
32