brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.3 KiB · 54127c0 Raw
52 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12module m13  use ISO_C_BINDING4  type shape5    integer :: color6    logical :: filled7    integer :: x8    integer :: y9  end type shape10  type, extends(shape) :: rectangle11    integer :: length12    integer :: width13  end type rectangle14  type, extends(rectangle) :: square15  end type square16 17  TYPE(shape), TARGET :: shape_obj18  TYPE(rectangle), TARGET :: rect_obj19 !define polymorphic objects20  class(shape), pointer :: shape_lim_polymorphic21end22subroutine C1165a23  use m124  shape_lim_polymorphic => rect_obj25  label : select type (shape_lim_polymorphic)26  end select label27  label1 : select type (shape_lim_polymorphic)28  !ERROR: SELECT TYPE construct name required but missing29  end select30  select type (shape_lim_polymorphic)31  !ERROR: SELECT TYPE construct name unexpected32  end select label233  select type (shape_lim_polymorphic)34  end select35end subroutine36subroutine C1165b37  use m138  shape_lim_polymorphic => rect_obj39!type-guard-stmt realted checks40label : select type (shape_lim_polymorphic)41  type is (shape) label42  end select label43 select type (shape_lim_polymorphic)44  !ERROR: SELECT TYPE name not allowed45  type is (shape) label46  end select47label : select type (shape_lim_polymorphic)48  !ERROR: SELECT TYPE name mismatch49  type is (shape) labelll50  end select label51end subroutine52