1module m
2  integer :: v
3  interface
4    subroutine foo(i)
5      integer :: i
6    end
7  end interface
8end
9
10subroutine bar
11  use m
12  implicit none
13  integer :: i
14  !$omp do reduction (task, +: v)  ! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" }
15  do i = 0, 63
16    call foo (i)
17  end do
18  !$omp end do nowait
19  !$omp sections reduction (task, +: v)	! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" }
20    call foo (-2)
21    !$omp section
22    call foo (-3)
23  !$omp end sections nowait
24  !$omp scope reduction (task, +: v)	! { dg-error "'task' reduction modifier on a construct with a 'nowait' clause" }
25  call foo (-4)
26  !$omp end scope nowait
27  !$omp simd reduction (task, +: v)	! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
28  do i = 0, 63
29    v = v + 1
30  end do
31  !$omp do simd reduction (task, +: v)	! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
32  do i = 0, 63
33    v = v + 1
34  end do
35  !$omp parallel do simd reduction (task, +: v)	! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
36  do i = 0, 63
37    v = v + 1
38  end do
39  !$omp end parallel do simd
40  !$omp teams distribute parallel do simd reduction (task, +: v)	! { dg-error "invalid 'task' reduction modifier on construct other than 'parallel', 'do', 'sections' or 'scope'" }
41  do i = 0, 63
42    v = v + 1
43  end do
44  !$omp end teams distribute parallel do simd
45end
46