1! RUN: %S/test_errors.sh %s %t %f18 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