flang/test/Semantics/dosemantics11.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   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
  11 subroutine s1()
  12 !ERROR: No matching DO construct for CYCLE statement
  13   cycle
  14 end subroutine s1
  15
  16 subroutine s2()
  17 !ERROR: No matching construct for EXIT statement
  18   exit
  19 end subroutine s2
  20
  21 subroutine s3()
  22   level0: block
  23 !ERROR: No matching DO construct for CYCLE statement
  24     cycle level0
  25   end block level0
  26 end subroutine s3
  27
  28 subroutine 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
  35 end subroutine s4
  36
  37 subroutine 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
  44 end subroutine s5
  45
  46 subroutine 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
  53 end subroutine s6
  54
  55 subroutine 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
  62 end subroutine s7
  63
  64 subroutine 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
  74 end subroutine s8
  75
  76 subroutine 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
  86 end subroutine s9
  87
  88 subroutine 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
 125 end subroutine s10
 126
 127 subroutine 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
 164 end subroutine s11
 165
 166 subroutine 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
 203 end subroutine s12
 204
 205 subroutine 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
 242 end subroutine s13
 243
 244 subroutine 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
 285 end subroutine s14
 286
 287 subroutine 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
 328 end subroutine s15