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