test/Semantics/selecttype02.f90

! RUN: %python %S/test_errors.py %s %flang_fc1
module m1
  use ISO_C_BINDING
  type shape
    integer :: color
    logical :: filled
    integer :: x
    integer :: y
  end type shape
  type, extends(shape) :: rectangle
    integer :: length
    integer :: width
  end type rectangle
  type, extends(rectangle) :: square
  end type square

  TYPE(shape), TARGET :: shape_obj
  TYPE(rectangle), TARGET :: rect_obj
 !define polymorphic objects
  class(shape), pointer :: shape_lim_polymorphic
end
subroutine C1165a
  use m1
  shape_lim_polymorphic => rect_obj
  label : select type (shape_lim_polymorphic)
  end select label
  label1 : select type (shape_lim_polymorphic)
  !ERROR: SELECT TYPE construct name required but missing
  end select
  select type (shape_lim_polymorphic)
  !ERROR: SELECT TYPE construct name unexpected
  end select label2
  select type (shape_lim_polymorphic)
  end select
end subroutine
subroutine C1165b
  use m1
  shape_lim_polymorphic => rect_obj
!type-guard-stmt realted checks
label : select type (shape_lim_polymorphic)
  type is (shape) label
  end select label
 select type (shape_lim_polymorphic)
  !ERROR: SELECT TYPE name not allowed
  type is (shape) label
  end select
label : select type (shape_lim_polymorphic)
  !ERROR: SELECT TYPE name mismatch
  type is (shape) labelll
  end select label
end subroutine