gcc/testsuite/gfortran.dg/func_derived_2.f90

   1 ! { dg-do run }
   2 ! This tests the "virtual fix" for PR19561, where functions returning
   3 ! pointers to derived types were not generating correct code.  This
   4 ! testcase is based on a simplified example in the PR discussion.
   5 !
   6 ! Submitted by Paul Thomas  pault@gcc.gnu.org
   7 ! Slightly extended by Tobias Schlüter
   8 module mpoint
   9   type           ::       mytype
  10     integer      ::       i
  11   end type mytype
  12
  13 contains
  14
  15   function get (a) result (b)
  16     type (mytype), target   ::      a
  17     type (mytype), pointer  ::      b
  18     b => a
  19   end function get
  20
  21   function get2 (a)
  22     type (mytype), target   ::      a
  23     type (mytype), pointer  ::      get2
  24     get2 => a
  25   end function get2
  26
  27 end module mpoint
  28
  29 program func_derived_2
  30   use mpoint
  31   type (mytype), target  ::       x
  32   type (mytype), pointer ::       y
  33   x = mytype (42)
  34   y => get (x)
  35   if (y%i.ne.42) call abort ()
  36
  37   x = mytype (112)
  38   y => get2 (x)
  39   if (y%i.ne.112) call abort ()
  40 end program func_derived_2
  41
  42 ! { dg-final { cleanup-modules "mpoint" } }