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