xref: /llvm-project/flang/test/Semantics/dosemantics11.f90 (revision 6c1ac141d3c98af9738bc77fcb55602cbff7751f)

! RUN: %python %S/test_errors.py %s %flang_fc1
! C1135 A cycle-stmt shall not appear within a CHANGE TEAM, CRITICAL, or DO
! CONCURRENT construct if it belongs to an outer construct.
!
! C1167 -- An exit-stmt shall not appear within a DO CONCURRENT construct if
! it belongs to that construct or an outer construct.
!
! C1168 -- An exit-stmt shall not appear within a CHANGE TEAM or CRITICAL
! construct if it belongs to an outer construct.

subroutine s1()
!ERROR: No matching DO construct for CYCLE statement
  cycle
end subroutine s1

subroutine s2()
!ERROR: No matching construct for EXIT statement
  exit
end subroutine s2

subroutine s3()
  level0: block
!ERROR: No matching DO construct for CYCLE statement
    cycle level0
  end block level0
end subroutine s3

subroutine s4()
  level0: do i = 1, 10
    level1: do concurrent (j = 1:20)
!ERROR: CYCLE must not leave a DO CONCURRENT statement
      cycle level0
    end do level1
  end do level0
end subroutine s4

subroutine s5()
  level0: do i = 1, 10
    level1: do concurrent (j = 1:20)
!ERROR: EXIT must not leave a DO CONCURRENT statement
      exit level0
    end do level1
  end do level0
end subroutine s5

subroutine s6()
  level0: do i = 1, 10
    level1: critical
!ERROR: CYCLE must not leave a CRITICAL statement
      cycle level0
    end critical level1
  end do level0
end subroutine s6

subroutine s7()
  level0: do i = 1, 10
    level1: critical
!ERROR: EXIT must not leave a CRITICAL statement
      exit level0
    end critical level1
  end do level0
end subroutine s7

subroutine s8()
  use :: iso_fortran_env
  type(team_type) team_var

  level0: do i = 1, 10
    level1: change team(team_var)
!ERROR: CYCLE must not leave a CHANGE TEAM statement
      cycle level0
    end team level1
  end do level0
end subroutine s8

subroutine s9()
  use :: iso_fortran_env
  type(team_type) team_var

  level0: do i = 1, 10
    level1: change team(team_var)
!ERROR: EXIT must not leave a CHANGE TEAM statement
      exit level0
    end team level1
  end do level0
end subroutine s9

subroutine s10(table)
! A complex, but all legal example

  integer :: table(..)

  type point
    real :: x, y
  end type point

  type, extends(point) :: color_point
    integer :: color
  end type color_point

  type(point), target :: target_var
  class(point), pointer :: p_or_c

  p_or_c => target_var
  level0: do i = 1, 10
    level1: associate (avar => ivar)
      level2: block
        level3: select case (l)
          case default
            print*, "default"
          case (1)
            level4: if (.true.) then
              level5: select rank(table)
                rank default
                  level6: select type ( a => p_or_c )
                  type is ( point )
                    cycle level0
                end select level6
              end select level5
            end if level4
        end select level3
      end block level2
    end associate level1
  end do level0
end subroutine s10

subroutine s11(table)
! A complex, but all legal example with a CYCLE statement

  integer :: table(..)

  type point
    real :: x, y
  end type point

  type, extends(point) :: color_point
    integer :: color
  end type color_point

  type(point), target :: target_var
  class(point), pointer :: p_or_c

  p_or_c => target_var
  level0: do i = 1, 10
    level1: associate (avar => ivar)
      level2: block
        level3: select case (l)
          case default
            print*, "default"
          case (1)
            level4: if (.true.) then
              level5: select rank(table)
                rank default
                  level6: select type ( a => p_or_c )
                  type is ( point )
                    cycle level0
                end select level6
              end select level5
            end if level4
        end select level3
      end block level2
    end associate level1
  end do level0
end subroutine s11

subroutine s12(table)
! A complex, but all legal example with an EXIT statement

  integer :: table(..)

  type point
    real :: x, y
  end type point

  type, extends(point) :: color_point
    integer :: color
  end type color_point

  type(point), target :: target_var
  class(point), pointer :: p_or_c

  p_or_c => target_var
  level0: do i = 1, 10
    level1: associate (avar => ivar)
      level2: block
        level3: select case (l)
          case default
            print*, "default"
          case (1)
            level4: if (.true.) then
              level5: select rank(table)
                rank default
                  level6: select type ( a => p_or_c )
                  type is ( point )
                    exit level0
                end select level6
              end select level5
            end if level4
        end select level3
      end block level2
    end associate level1
  end do level0
end subroutine s12

subroutine s13(table)
! Similar example without construct names

  integer :: table(..)

  type point
    real :: x, y
  end type point

  type, extends(point) :: color_point
    integer :: color
  end type color_point

  type(point), target :: target_var
  class(point), pointer :: p_or_c

  p_or_c => target_var
  do i = 1, 10
    associate (avar => ivar)
      block
        select case (l)
          case default
            print*, "default"
          case (1)
            if (.true.) then
              select rank(table)
                rank default
                  select type ( a => p_or_c )
                  type is ( point )
                    cycle
                end select
              end select
            end if
        end select
      end block
    end associate
  end do
end subroutine s13

subroutine s14(table)

  integer :: table(..)

  type point
    real :: x, y
  end type point

  type, extends(point) :: color_point
    integer :: color
  end type color_point

  type(point), target :: target_var
  class(point), pointer :: p_or_c

  p_or_c => target_var
  do i = 1, 10
    associate (avar => ivar)
      block
        critical
          select case (l)
            case default
              print*, "default"
            case (1)
              if (.true.) then
                select rank(table)
                  rank default
                    select type ( a => p_or_c )
                    type is ( point )
!ERROR: CYCLE must not leave a CRITICAL statement
                      cycle
!ERROR: EXIT must not leave a CRITICAL statement
                      exit
                  end select
                end select
              end if
          end select
        end critical
      end block
    end associate
  end do
end subroutine s14

subroutine s15(table)
! Illegal EXIT to an intermediated construct

  integer :: table(..)

  type point
    real :: x, y
  end type point

  type, extends(point) :: color_point
    integer :: color
  end type color_point

  type(point), target :: target_var
  class(point), pointer :: p_or_c

  p_or_c => target_var
  level0: do i = 1, 10
    level1: associate (avar => ivar)
      level2: block
        level3: select case (l)
          case default
            print*, "default"
          case (1)
            level4: if (.true.) then
              level5: critical
                level6: select rank(table)
                  rank default
                    level7: select type ( a => p_or_c )
                    type is ( point )
                      exit level6
!ERROR: EXIT must not leave a CRITICAL statement
                      exit level4
                  end select level7
                end select level6
              end critical level5
            end if level4
        end select level3
      end block level2
    end associate level1
  end do level0
end subroutine s15