1! { dg-options "-O2" }
2
3  integer, save :: u(64), v
4  integer :: min_iters, max_iters, ntasks, cnt
5  procedure(grainsize), pointer :: fn
6  !$omp parallel
7  !$omp single
8    fn => grainsize
9    ! If grainsize is present, # of task loop iters is
10    ! >= grainsize && < 2 * grainsize,
11    ! unless # of loop iterations is smaller than grainsize.
12    call test (0, 79, 1, 17, fn, ntasks, min_iters, max_iters, cnt)
13    if (cnt .ne. 79) stop 1
14    if (min_iters .lt. 17 .or. max_iters .ge. 17 * 2) stop 2
15    call test (-49, 2541, 7, 28, fn, ntasks, min_iters, max_iters, cnt)
16    if (cnt .ne. 370) stop 3
17    if (min_iters .lt. 28 .or. max_iters .ge. 28 * 2) stop 4
18    call test (7, 21, 2, 15, fn, ntasks, min_iters, max_iters, cnt)
19    if (cnt .ne. 7) stop 5
20    if (min_iters .ne. 7 .or. max_iters .ne. 7) stop 6
21    if (ntasks .ne. 1) stop 7
22    fn => num_tasks
23    ! If num_tasks is present, # of task loop iters is
24    ! min (# of loop iters, num_tasks).
25    call test (-51, 2500, 48, 9, fn, ntasks, min_iters, max_iters, cnt)
26    if (cnt .ne. 54 .or. ntasks .ne. 9) stop 8
27    call test (0, 25, 2, 17, fn, ntasks, min_iters, max_iters, cnt)
28    if (cnt .ne. 13 .or. ntasks .ne. 13) stop 9
29  !$omp end single
30  !$omp end parallel
31contains
32  subroutine grainsize (a, b, c, d)
33    integer, intent (in) :: a, b, c, d
34    integer :: i, j, k
35    j = 0
36    k = 0
37    !$omp taskloop firstprivate (j, k) grainsize (d)
38    do i = a, b - 1, c
39      if (j .eq. 0) then
40        !$omp atomic capture
41          k = v
42          v = v + 1
43        !$omp end atomic
44        if (k .ge. 64) stop 10
45      end if
46      j = j + 1
47      u(k + 1) = j
48    end do
49  end subroutine grainsize
50  subroutine num_tasks (a, b, c, d)
51    integer, intent (in) :: a, b, c, d
52    integer :: i, j, k
53    j = 0
54    k = 0
55    !$omp taskloop firstprivate (j, k) num_tasks (d)
56    do i = a, b - 1, c
57      if (j .eq. 0) then
58        !$omp atomic capture
59          k = v
60          v = v + 1
61        !$omp end atomic
62        if (k .ge. 64) stop 11
63      end if
64      j = j + 1
65      u(k + 1) = j
66    end do
67  end subroutine num_tasks
68  subroutine test (a, b, c, d, fn, num_tasks, min_iters, max_iters, cnt)
69    integer, intent (in) :: a, b, c, d
70    procedure(grainsize), pointer :: fn
71    integer, intent (out) :: num_tasks, min_iters, max_iters, cnt
72    integer :: i
73    u(:) = 0
74    v = 0
75    cnt = 0
76    call fn (a, b, c, d)
77    min_iters = 0
78    max_iters = 0
79    num_tasks = v
80    if (v .ne. 0) then
81      min_iters = minval (u(1:v))
82      max_iters = maxval (u(1:v))
83      cnt = sum (u(1:v))
84    end if
85  end subroutine test
86end
87