329 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! 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 statement13 cycle14end subroutine s115 16subroutine s2()17!ERROR: No matching construct for EXIT statement18 exit19end subroutine s220 21subroutine s3()22 level0: block23!ERROR: No matching DO construct for CYCLE statement24 cycle level025 end block level026end subroutine s327 28subroutine s4()29 level0: do i = 1, 1030 level1: do concurrent (j = 1:20)31!ERROR: CYCLE must not leave a DO CONCURRENT statement32 cycle level033 end do level134 end do level035end subroutine s436 37subroutine s5()38 level0: do i = 1, 1039 level1: do concurrent (j = 1:20)40!ERROR: EXIT must not leave a DO CONCURRENT statement41 exit level042 end do level143 end do level044end subroutine s545 46subroutine s6()47 level0: do i = 1, 1048 level1: critical49!ERROR: CYCLE must not leave a CRITICAL statement50 cycle level051 end critical level152 end do level053end subroutine s654 55subroutine s7()56 level0: do i = 1, 1057 level1: critical58!ERROR: EXIT must not leave a CRITICAL statement59 exit level060 end critical level161 end do level062end subroutine s763 64subroutine s8()65 use :: iso_fortran_env66 type(team_type) team_var67 68 level0: do i = 1, 1069 level1: change team(team_var)70!ERROR: CYCLE must not leave a CHANGE TEAM statement71 cycle level072 end team level173 end do level074end subroutine s875 76subroutine s9()77 use :: iso_fortran_env78 type(team_type) team_var79 80 level0: do i = 1, 1081 level1: change team(team_var)82!ERROR: EXIT must not leave a CHANGE TEAM statement83 exit level084 end team level185 end do level086end subroutine s987 88subroutine s10(table)89! A complex, but all legal example90 91 integer :: table(..)92 93 type point94 real :: x, y95 end type point96 97 type, extends(point) :: color_point98 integer :: color99 end type color_point100 101 type(point), target :: target_var102 class(point), pointer :: p_or_c103 104 p_or_c => target_var105 level0: do i = 1, 10106 level1: associate (avar => ivar)107 level2: block108 level3: select case (l)109 case default110 print*, "default"111 case (1)112 level4: if (.true.) then113 level5: select rank(table)114 rank default115 level6: select type ( a => p_or_c )116 type is ( point )117 cycle level0118 end select level6119 end select level5120 end if level4121 end select level3122 end block level2123 end associate level1124 end do level0125end subroutine s10126 127subroutine s11(table)128! A complex, but all legal example with a CYCLE statement129 130 integer :: table(..)131 132 type point133 real :: x, y134 end type point135 136 type, extends(point) :: color_point137 integer :: color138 end type color_point139 140 type(point), target :: target_var141 class(point), pointer :: p_or_c142 143 p_or_c => target_var144 level0: do i = 1, 10145 level1: associate (avar => ivar)146 level2: block147 level3: select case (l)148 case default149 print*, "default"150 case (1)151 level4: if (.true.) then152 level5: select rank(table)153 rank default154 level6: select type ( a => p_or_c )155 type is ( point )156 cycle level0157 end select level6158 end select level5159 end if level4160 end select level3161 end block level2162 end associate level1163 end do level0164end subroutine s11165 166subroutine s12(table)167! A complex, but all legal example with an EXIT statement168 169 integer :: table(..)170 171 type point172 real :: x, y173 end type point174 175 type, extends(point) :: color_point176 integer :: color177 end type color_point178 179 type(point), target :: target_var180 class(point), pointer :: p_or_c181 182 p_or_c => target_var183 level0: do i = 1, 10184 level1: associate (avar => ivar)185 level2: block186 level3: select case (l)187 case default188 print*, "default"189 case (1)190 level4: if (.true.) then191 level5: select rank(table)192 rank default193 level6: select type ( a => p_or_c )194 type is ( point )195 exit level0196 end select level6197 end select level5198 end if level4199 end select level3200 end block level2201 end associate level1202 end do level0203end subroutine s12204 205subroutine s13(table)206! Similar example without construct names207 208 integer :: table(..)209 210 type point211 real :: x, y212 end type point213 214 type, extends(point) :: color_point215 integer :: color216 end type color_point217 218 type(point), target :: target_var219 class(point), pointer :: p_or_c220 221 p_or_c => target_var222 do i = 1, 10223 associate (avar => ivar)224 block225 select case (l)226 case default227 print*, "default"228 case (1)229 if (.true.) then230 select rank(table)231 rank default232 select type ( a => p_or_c )233 type is ( point )234 cycle235 end select236 end select237 end if238 end select239 end block240 end associate241 end do242end subroutine s13243 244subroutine s14(table)245 246 integer :: table(..)247 248 type point249 real :: x, y250 end type point251 252 type, extends(point) :: color_point253 integer :: color254 end type color_point255 256 type(point), target :: target_var257 class(point), pointer :: p_or_c258 259 p_or_c => target_var260 do i = 1, 10261 associate (avar => ivar)262 block263 critical264 select case (l)265 case default266 print*, "default"267 case (1)268 if (.true.) then269 select rank(table)270 rank default271 select type ( a => p_or_c )272 type is ( point )273!ERROR: CYCLE must not leave a CRITICAL statement274 cycle275!ERROR: EXIT must not leave a CRITICAL statement276 exit277 end select278 end select279 end if280 end select281 end critical282 end block283 end associate284 end do285end subroutine s14286 287subroutine s15(table)288! Illegal EXIT to an intermediated construct289 290 integer :: table(..)291 292 type point293 real :: x, y294 end type point295 296 type, extends(point) :: color_point297 integer :: color298 end type color_point299 300 type(point), target :: target_var301 class(point), pointer :: p_or_c302 303 p_or_c => target_var304 level0: do i = 1, 10305 level1: associate (avar => ivar)306 level2: block307 level3: select case (l)308 case default309 print*, "default"310 case (1)311 level4: if (.true.) then312 level5: critical313 level6: select rank(table)314 rank default315 level7: select type ( a => p_or_c )316 type is ( point )317 exit level6318!ERROR: EXIT must not leave a CRITICAL statement319 exit level4320 end select level7321 end select level6322 end critical level5323 end if level4324 end select level3325 end block level2326 end associate level1327 end do level0328end subroutine s15329