flang/test/Semantics/dosemantics11.f90

   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
  12 subroutine s1()
  13 !ERROR: No matching DO construct for CYCLE statement
  14   cycle
  15 end subroutine s1
  16
  17 subroutine s2()
  18 !ERROR: No matching construct for EXIT statement
  19   exit
  20 end subroutine s2
  21
  22 subroutine s3()
  23   level0: block
  24 !ERROR: No matching DO construct for CYCLE statement
  25     cycle level0
  26   end block level0
  27 end subroutine s3
  28
  29 subroutine 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
  36 end subroutine s4
  37
  38 subroutine 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
  45 end subroutine s5
  46
  47 subroutine 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
  54 end subroutine s6
  55
  56 subroutine 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
  63 end subroutine s7
  64
  65 subroutine 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
  75 end subroutine s8
  76
  77 subroutine 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
  87 end subroutine s9
  88
  89 subroutine 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
 126 end subroutine s10
 127
 128 subroutine 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
 165 end subroutine s11
 166
 167 subroutine 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
 204 end subroutine s12
 205
 206 subroutine 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
 243 end subroutine s13
 244
 245 subroutine 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
 286 end subroutine s14
 287
 288 subroutine 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
 329 end subroutine s15