gcc/testsuite/gfortran.dg/select_type_2.f03

   1 ! { dg-do run }
   2 !
   3 ! executing simple SELECT TYPE statements
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7   type :: t1
   8     integer :: i
   9   end type t1
  10
  11   type, extends(t1) :: t2
  12     integer :: j
  13   end type t2
  14
  15   type, extends(t1) :: t3
  16     real :: r
  17   end type
  18
  19   class(t1), pointer :: cp
  20   type(t1), target :: a
  21   type(t2), target :: b
  22   type(t3), target :: c
  23   integer :: i
  24
  25   cp => a
  26   i = 0
  27
  28   select type (cp)
  29   type is (t1)
  30     i = 1
  31   type is (t2)
  32     i = 2
  33   class is (t1)
  34     i = 3
  35   end select
  36
  37   if (i /= 1) call abort()
  38
  39   cp => b
  40   i = 0
  41
  42   select type (cp)
  43   type is (t1)
  44     i = 1
  45   type is (t2)
  46     i = 2
  47   class is (t2)
  48     i = 3
  49   end select
  50
  51   if (i /= 2) call abort()
  52
  53   cp => c
  54   i = 0
  55
  56   select type (cp)
  57   type is (t1)
  58     i = 1
  59   type is (t2)
  60     i = 2
  61   class default
  62     i = 3
  63   end select
  64
  65   if (i /= 3) call abort()
  66
  67 end