1module m
2  integer a, b
3end module m
4
5subroutine f1
6  use m
7  !$omp scan inclusive (a)  ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" }
8  !$omp scan exclusive (b)  ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" }
9end
10
11subroutine f2 (c, d, e, f)
12  use m
13  implicit none
14  integer i, l, c(*), d(*), e(64), f(64)
15  l = 1
16
17  !$omp do reduction (inscan, +: a) reduction (+: b)  ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" }
18  do i = 1, 64
19    block
20      b = b + 1
21      a = a + c(i)
22    end block
23    !$omp scan inclusive (a)
24    d(i) = a
25  end do
26
27  !$omp do reduction (+: a) reduction (inscan, +: b)  ! { dg-error "'inscan' and non-'inscan' 'reduction' clauses on the same construct" }
28  do i = 1, 64
29    block
30      a = a + 1
31      b = b + c(i)
32    end block
33    !$omp scan inclusive (b)
34      d(i) = b
35  end do
36
37  !$omp do reduction (inscan, +: e)
38  do i = 1, 64
39    block
40      e(1) = e(1) + c(i)
41      e(2) = e(2) + c(i)
42    end block
43    !$omp scan inclusive (a, e)
44    block
45      d(1) = e(1)
46      f(2) = e(2)
47    end block
48  end do
49
50  !$omp do reduction (inscan, +: e(:2))  ! { dg-error "Syntax error in OpenMP variable list" }
51  do i = 1, 64
52    block
53      e(1) = e(1) + c(i)
54      e(2) = e(2) + c(i)
55    end block
56    !$omp scan inclusive (a, e) ! { dg-error "outside loop construct with 'inscan' REDUCTION clause" }
57    block
58      d(1) = e(1)
59      f(2) = e(2)
60    end block
61  end do
62
63  !$omp do reduction (inscan, +: a) ordered    ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" }
64  do i = 1, 64
65    a = a + c(i)
66    !$omp scan inclusive (a)
67    d(i) = a
68  end do
69
70  !$omp do reduction (inscan, +: a) ordered(1)    ! { dg-error "ORDERED clause specified together with 'inscan' REDUCTION clause" }
71  do i = 1, 64
72    a = a + c(i)
73    !$omp scan inclusive (a)
74    d(i) = a
75  end do
76
77  !$omp do reduction (inscan, +: a) schedule(static)  ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" }
78  do i = 1, 64
79    a = a + c(i)
80    !$omp scan inclusive (a)
81    d(i) = a
82  end do
83
84  !$omp do reduction (inscan, +: a) schedule(static, 2)  ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" }
85  do i = 1, 64
86    a = a + c(i)
87    !$omp scan inclusive (a)
88    d(i) = a
89  end do
90
91  !$omp do reduction (inscan, +: a) schedule(nonmonotonic: dynamic, 2)  ! { dg-error "SCHEDULE clause specified together with 'inscan' REDUCTION clause" }
92  do i = 1, 64
93    a = a + c(i)
94    !$omp scan inclusive (a)
95    d(i) = a
96  end do
97end
98
99subroutine f3 (c, d)
100  use m
101  implicit none
102  integer i, c(64), d(64)
103  !$omp teams reduction (inscan, +: a)  ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause at" }
104    ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
105    ! ...
106  !$omp end teams
107
108  !$omp target parallel do reduction (inscan, +: a) map (c, d)
109  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
110  do i = 1, 64
111    d(i) = a
112    !$omp scan exclusive (a)
113    a = a + c(i)
114  end do
115  !$omp teams
116  !$omp distribute parallel do reduction (inscan, +: a)
117  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
118  do i = 1, 64
119    d(i) = a
120    !$omp scan exclusive (a)
121    a = a + c(i)
122  end do
123  !$omp end teams
124
125  !$omp distribute parallel do simd reduction (inscan, +: a)
126  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
127  do i = 1, 64
128    d(i) = a
129    !$omp scan exclusive (a)
130    a = a + c(i)
131  end do
132end
133
134subroutine f4 (c, d)
135  use m
136  implicit none
137  integer i, c(64), d(64)
138  !$omp taskloop reduction (inscan, +: a)  ! { dg-error "Only DEFAULT permitted as reduction-modifier in REDUCTION clause" }
139  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" "" { target *-*-* } .-1 }
140  do i = 1, 64
141    d(i) = a
142    !$omp scan exclusive (a)
143    a = a + c(i)
144  end do
145end
146
147subroutine f7
148  use m
149  implicit none
150  integer i
151  !$omp simd reduction (inscan, +: a)
152  do i = 1, 64
153    if (i == 23) then  ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 }
154      cycle  ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } }
155    elseif (i == 27) then
156      goto 123  ! Diagnostic by ME, see scan-7.f90
157      ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
158    endif
159    !$omp scan exclusive (a)
160    block
161123 a = 0  ! { dg-error "jump to label 'l1'" "" { target c++ } }
162           ! { dg-warning "is not in the same block as the GOTO statement" "" { target *-*-* } .-1 }
163      if (i == 33) then  ! { dg-error "invalid exit from OpenMP structured block" "" { target c++ } .+1 }
164        cycle  ! { dg-error "invalid branch to/from OpenMP structured block" "" { target c } }
165      end if
166    end block
167  end do
168end
169
170subroutine f8 (c, d, e, f)
171  use m
172  implicit none
173  integer i, c(64), d(64), e(64), f(64)
174  !$omp do reduction (inscan, +: a, b)	  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
175  do i = 1, 64
176    block
177      a = a + c(i)
178      b = b + d(i)
179    end block
180    !$omp scan inclusive (a) inclusive (b)  ! { dg-error "Unexpected junk after ..OMP SCAN" }
181    block
182      e(i) = a
183      f(i) = b
184    end block
185  end do
186
187  !$omp do reduction (inscan, +: a, b)  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
188  do i = 1, 64
189    block
190      a = a + c(i)
191      b = b + d(i)
192    end block
193    !$omp scan  ! { dg-error "Expected INCLUSIVE or EXCLUSIVE clause" }
194    block
195      e(i) = a
196      f(i) = b
197    end block
198  end do
199end
200
201subroutine f9
202  use m
203  implicit none
204  integer i
205! The first error (exit) causes two follow-up errors:
206  !$omp simd reduction (inscan, +: a)  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" }
207  do i = 1, 64
208    if (i == 23) &
209      exit  ! { dg-error "EXIT statement at .1. terminating ..OMP DO loop" } */
210    !$omp scan exclusive (a) ! { dg-error "Unexpected ..OMP SCAN at .1. outside loop construct with 'inscan' REDUCTION clause" }
211    a = a + 1
212  end do
213end
214