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