1! RUN: %python %S/test_errors.py %s %flang_fc1
2! C1135 A cycle-stmt shall not appear within a CHANGE TEAM, CRITICAL, or DO
3! CONCURRENT construct if it belongs to an outer construct.
4!
5! C1167 -- An exit-stmt shall not appear within a DO CONCURRENT construct if
6! it belongs to that construct or an outer construct.
7!
8! C1168 -- An exit-stmt shall not appear within a CHANGE TEAM or CRITICAL
9! construct if it belongs to an outer construct.
10
11subroutine s1()
12!ERROR: No matching DO construct for CYCLE statement
13  cycle
14end subroutine s1
15
16subroutine s2()
17!ERROR: No matching construct for EXIT statement
18  exit
19end subroutine s2
20
21subroutine s3()
22  level0: block
23!ERROR: No matching DO construct for CYCLE statement
24    cycle level0
25  end block level0
26end subroutine s3
27
28subroutine s4()
29  level0: do i = 1, 10
30    level1: do concurrent (j = 1:20)
31!ERROR: CYCLE must not leave a DO CONCURRENT statement
32      cycle level0
33    end do level1
34  end do level0
35end subroutine s4
36
37subroutine s5()
38  level0: do i = 1, 10
39    level1: do concurrent (j = 1:20)
40!ERROR: EXIT must not leave a DO CONCURRENT statement
41      exit level0
42    end do level1
43  end do level0
44end subroutine s5
45
46subroutine s6()
47  level0: do i = 1, 10
48    level1: critical
49!ERROR: CYCLE must not leave a CRITICAL statement
50      cycle level0
51    end critical level1
52  end do level0
53end subroutine s6
54
55subroutine s7()
56  level0: do i = 1, 10
57    level1: critical
58!ERROR: EXIT must not leave a CRITICAL statement
59      exit level0
60    end critical level1
61  end do level0
62end subroutine s7
63
64subroutine s8()
65  use :: iso_fortran_env
66  type(team_type) team_var
67
68  level0: do i = 1, 10
69    level1: change team(team_var)
70!ERROR: CYCLE must not leave a CHANGE TEAM statement
71      cycle level0
72    end team level1
73  end do level0
74end subroutine s8
75
76subroutine s9()
77  use :: iso_fortran_env
78  type(team_type) team_var
79
80  level0: do i = 1, 10
81    level1: change team(team_var)
82!ERROR: EXIT must not leave a CHANGE TEAM statement
83      exit level0
84    end team level1
85  end do level0
86end subroutine s9
87
88subroutine s10(table)
89! A complex, but all legal example
90
91  integer :: table(..)
92
93  type point
94    real :: x, y
95  end type point
96
97  type, extends(point) :: color_point
98    integer :: color
99  end type color_point
100
101  type(point), target :: target_var
102  class(point), pointer :: p_or_c
103
104  p_or_c => target_var
105  level0: do i = 1, 10
106    level1: associate (avar => ivar)
107      level2: block
108        level3: select case (l)
109          case default
110            print*, "default"
111          case (1)
112            level4: if (.true.) then
113              level5: select rank(table)
114                rank default
115                  level6: select type ( a => p_or_c )
116                  type is ( point )
117                    cycle level0
118                end select level6
119              end select level5
120            end if level4
121        end select level3
122      end block level2
123    end associate level1
124  end do level0
125end subroutine s10
126
127subroutine s11(table)
128! A complex, but all legal example with a CYCLE statement
129
130  integer :: table(..)
131
132  type point
133    real :: x, y
134  end type point
135
136  type, extends(point) :: color_point
137    integer :: color
138  end type color_point
139
140  type(point), target :: target_var
141  class(point), pointer :: p_or_c
142
143  p_or_c => target_var
144  level0: do i = 1, 10
145    level1: associate (avar => ivar)
146      level2: block
147        level3: select case (l)
148          case default
149            print*, "default"
150          case (1)
151            level4: if (.true.) then
152              level5: select rank(table)
153                rank default
154                  level6: select type ( a => p_or_c )
155                  type is ( point )
156                    cycle level0
157                end select level6
158              end select level5
159            end if level4
160        end select level3
161      end block level2
162    end associate level1
163  end do level0
164end subroutine s11
165
166subroutine s12(table)
167! A complex, but all legal example with an EXIT statement
168
169  integer :: table(..)
170
171  type point
172    real :: x, y
173  end type point
174
175  type, extends(point) :: color_point
176    integer :: color
177  end type color_point
178
179  type(point), target :: target_var
180  class(point), pointer :: p_or_c
181
182  p_or_c => target_var
183  level0: do i = 1, 10
184    level1: associate (avar => ivar)
185      level2: block
186        level3: select case (l)
187          case default
188            print*, "default"
189          case (1)
190            level4: if (.true.) then
191              level5: select rank(table)
192                rank default
193                  level6: select type ( a => p_or_c )
194                  type is ( point )
195                    exit level0
196                end select level6
197              end select level5
198            end if level4
199        end select level3
200      end block level2
201    end associate level1
202  end do level0
203end subroutine s12
204
205subroutine s13(table)
206! Similar example without construct names
207
208  integer :: table(..)
209
210  type point
211    real :: x, y
212  end type point
213
214  type, extends(point) :: color_point
215    integer :: color
216  end type color_point
217
218  type(point), target :: target_var
219  class(point), pointer :: p_or_c
220
221  p_or_c => target_var
222  do i = 1, 10
223    associate (avar => ivar)
224      block
225        select case (l)
226          case default
227            print*, "default"
228          case (1)
229            if (.true.) then
230              select rank(table)
231                rank default
232                  select type ( a => p_or_c )
233                  type is ( point )
234                    cycle
235                end select
236              end select
237            end if
238        end select
239      end block
240    end associate
241  end do
242end subroutine s13
243
244subroutine s14(table)
245
246  integer :: table(..)
247
248  type point
249    real :: x, y
250  end type point
251
252  type, extends(point) :: color_point
253    integer :: color
254  end type color_point
255
256  type(point), target :: target_var
257  class(point), pointer :: p_or_c
258
259  p_or_c => target_var
260  do i = 1, 10
261    associate (avar => ivar)
262      block
263        critical
264          select case (l)
265            case default
266              print*, "default"
267            case (1)
268              if (.true.) then
269                select rank(table)
270                  rank default
271                    select type ( a => p_or_c )
272                    type is ( point )
273!ERROR: CYCLE must not leave a CRITICAL statement
274                      cycle
275!ERROR: EXIT must not leave a CRITICAL statement
276                      exit
277                  end select
278                end select
279              end if
280          end select
281        end critical
282      end block
283    end associate
284  end do
285end subroutine s14
286
287subroutine s15(table)
288! Illegal EXIT to an intermediated construct
289
290  integer :: table(..)
291
292  type point
293    real :: x, y
294  end type point
295
296  type, extends(point) :: color_point
297    integer :: color
298  end type color_point
299
300  type(point), target :: target_var
301  class(point), pointer :: p_or_c
302
303  p_or_c => target_var
304  level0: do i = 1, 10
305    level1: associate (avar => ivar)
306      level2: block
307        level3: select case (l)
308          case default
309            print*, "default"
310          case (1)
311            level4: if (.true.) then
312              level5: critical
313                level6: select rank(table)
314                  rank default
315                    level7: select type ( a => p_or_c )
316                    type is ( point )
317                      exit level6
318!ERROR: EXIT must not leave a CRITICAL statement
319                      exit level4
320                  end select level7
321                end select level6
322              end critical level5
323            end if level4
324        end select level3
325      end block level2
326    end associate level1
327  end do level0
328end subroutine s15
329