gcc/testsuite/gfortran.dg/associate_8.f03

   1 ! { dg-do run}
   2 ! { dg-options "-std=f2003 -fall-intrinsics" }
   3
   4 ! PR fortran/38936
   5 ! Check associate to polymorphic entities.
   6
   7 ! Contributed by Tobias Burnus, burnus@gcc.gnu.org.
   8
   9 type t
  10 end type t
  11
  12 type, extends(t) :: t2
  13 end type t2
  14
  15 class(t), allocatable :: a, b
  16 allocate( t :: a)
  17 allocate( t2 :: b)
  18
  19 associate ( one => a, two => b)
  20   select type(two)
  21     type is (t)
  22       call abort ()
  23     type is (t2)
  24       print *, 'OK', two
  25     class default
  26       call abort ()
  27   end select
  28   select type(one)
  29     type is (t2)
  30       call abort ()
  31     type is (t)
  32       print *, 'OK', one
  33     class default
  34       call abort ()
  35   end select
  36 end associate
  37 end