1module m
2  integer a, b
3end module m
4
5subroutine f2 (c, d, e, f)
6  use m
7  implicit none
8  integer i, l, c(*), d(*), e(64), f(64)
9  l = 1
10
11  !$omp do reduction (inscan, +: a) linear (l)    ! { dg-error "'inscan' 'reduction' clause used together with 'linear' clause for a variable other than loop iterator" }
12  do i = 1, 64
13    block
14      a = a + c(i)
15      l = l + 1
16    end block
17    !$omp scan inclusive (a)
18    d(i) = a
19  end do
20end
21
22subroutine f5 (c, d)
23  use m
24  implicit none
25  integer i, c(64), d(64)
26  !$omp simd reduction (inscan, +: a)
27  do i = 1, 64
28    d(i) = a
29    !$omp scan exclusive (a, b)  ! { dg-error "'b' specified in 'exclusive' clause but not in 'inscan' 'reduction' clause on the containing construct" }
30    a = a + c(i)
31  end do
32end
33
34subroutine f6 (c, d)
35  use m
36  implicit none
37  integer i, c(64), d(64)
38  !$omp simd reduction (inscan, +: a, b)  ! { dg-error "'b' specified in 'inscan' 'reduction' clause but not in 'scan' directive clause" }
39  do i = 1, 64
40    d(i) = a
41    !$omp scan exclusive (a)
42    a = a + c(i)
43  end do
44end
45
46subroutine f7
47  use m
48  implicit none
49  integer i
50  !$omp simd reduction (inscan, +: a)
51  do i = 1, 64
52    if (i == 27) goto 123  ! { dg-error "invalid branch to/from OpenMP structured block" }
53      ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
54    !$omp scan exclusive (a)
55    block
56123   a = 0  ! { dg-error "jump to label 'l1'" "" { target c++ } }
57             ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
58    end block
59  end do
60end
61