trunk/gcc/testsuite/gfortran.dg/select_type_6.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 41579: [OOP/Polymorphism] Nesting of SELECT TYPE
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6
   7  type t1
   8  end type t1
   9
  10  type, extends(t1) :: t2
  11   integer :: i
  12  end type t2
  13
  14  type, extends(t1) :: t3
  15   integer :: j
  16  end type t3
  17
  18  class(t1), allocatable :: mt2, mt3
  19  allocate(t2 :: mt2)
  20  allocate(t3 :: mt3)
  21
  22  select type (mt2)
  23  type is(t2)
  24    mt2%i = 5
  25    print *,mt2%i
  26    select type(mt3)
  27    type is(t3)
  28      mt3%j = 2*mt2%i
  29      print *,mt3%j
  30      if (mt3%j /= 10) call abort()
  31    class default
  32      call abort()
  33    end select
  34  class default
  35    call abort()
  36  end select
  37
  38 end