gcc/testsuite/gfortran.dg/select_type_5.f03

   1 ! { dg-do run }
   2 !
   3 ! SELECT TYPE with associate-name
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7   type :: t1
   8     integer :: i = -1
   9     class(t1), pointer :: c
  10   end type t1
  11
  12   type, extends(t1) :: t2
  13     integer :: j = -1
  14   end type t2
  15
  16   type(t2), target :: b
  17   integer :: aa
  18
  19   b%c => b
  20   aa = 5
  21
  22   select type (aa => b%c)
  23   type is (t1)
  24     aa%i = 1
  25   type is (t2)
  26     aa%j = 2
  27   end select
  28
  29   print *,b%i,b%j
  30   if (b%i /= -1) call abort()
  31   if (b%j /= 2) call abort()
  32
  33   select type (aa => b%c)
  34   type is (t1)
  35     aa%i = 4
  36   type is (t2)
  37     aa%i = 3*aa%j
  38   end select
  39
  40   print *,b%i,b%j
  41   if (b%i /= 6) call abort()
  42   if (b%j /= 2) call abort()
  43
  44   print *,aa
  45   if (aa/=5) call abort()
  46
  47 end