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