embedded-5_0-branch/gcc/testsuite/gfortran.dg/pointer_assign_10.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/57530
   4 !
   5 !
   6 ! TYPE => TYPE pointer assignment for functions
   7 !
   8 module m
   9   implicit none
  10   type t
  11     integer :: ii = 55
  12   end type t
  13 contains
  14   function f1()
  15     type(t), pointer :: f1
  16     allocate (f1)
  17     f1%ii = 123
  18   end function f1
  19   function f2()
  20     type(t), pointer :: f2(:)
  21     allocate (f2(3))
  22     f2(:)%ii = [-11,-22,-33]
  23   end function f2
  24 end module m
  25
  26 program test
  27   use m
  28   implicit none
  29   type(t), pointer :: p1, p2(:), p3(:,:)
  30   p1 => f1()
  31   if (p1%ii /= 123) call abort ()
  32   p2 => f2()
  33   if (any (p2%ii /= [-11,-22,-33])) call abort ()
  34   p3(2:2,1:3) => f2()
  35   if (any (p3(2,:)%ii /= [-11,-22,-33])) call abort ()
  36 end program test