gcc/testsuite/gfortran.dg/select_type_3.f03

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