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