flang/test/Semantics/selecttype02.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 module 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
  21 end
  22 subroutine 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
  35 end subroutine
  36 subroutine C1165b
  37   use m1
  38   shape_lim_polymorphic => rect_obj
  39 !type-guard-stmt realted checks
  40 label : 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
  47 label : select type (shape_lim_polymorphic)
  48   !ERROR: SELECT TYPE name mismatch
  49   type is (shape) labelll
  50   end select label
  51 end subroutine