flang/test/Semantics/selecttype02.f90

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