1! RUN: %python %S/test_errors.py %s %flang_fc1
2module m1
3  use ISO_C_BINDING
4  type shape
5    integer :: color
6    logical :: filled
7    integer :: x
8    integer :: y
9  end type shape
10  type, extends(shape) :: rectangle
11    integer :: length
12    integer :: width
13  end type rectangle
14  type, extends(rectangle) :: square
15  end type square
16
17  TYPE(shape), TARGET :: shape_obj
18  TYPE(rectangle), TARGET :: rect_obj
19 !define polymorphic objects
20  class(shape), pointer :: shape_lim_polymorphic
21end
22subroutine C1165a
23  use m1
24  shape_lim_polymorphic => rect_obj
25  label : select type (shape_lim_polymorphic)
26  end select label
27  label1 : select type (shape_lim_polymorphic)
28  !ERROR: SELECT TYPE construct name required but missing
29  end select
30  select type (shape_lim_polymorphic)
31  !ERROR: SELECT TYPE construct name unexpected
32  end select label2
33  select type (shape_lim_polymorphic)
34  end select
35end subroutine
36subroutine C1165b
37  use m1
38  shape_lim_polymorphic => rect_obj
39!type-guard-stmt realted checks
40label : select type (shape_lim_polymorphic)
41  type is (shape) label
42  end select label
43 select type (shape_lim_polymorphic)
44  !ERROR: SELECT TYPE name not allowed
45  type is (shape) label
46  end select
47label : select type (shape_lim_polymorphic)
48  !ERROR: SELECT TYPE name mismatch
49  type is (shape) labelll
50  end select label
51end subroutine
52