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