gcc/testsuite/gfortran.dg/associated_1.f90

   1 ! { dg-do run }
   2 ! PR 25292: Check that the intrinsic associated works with functions returning
   3 ! pointers as arguments
   4 program test
   5    real, pointer :: a, b
   6
   7    nullify(a,b)
   8    if(associated(a,b).or.associated(a,a)) call abort()
   9    allocate(a)
  10    if(associated(b,a)) call abort()
  11    if (.not.associated(x(a))) call abort ()
  12    if (.not.associated(a, x(a))) call abort ()
  13
  14    nullify(b)
  15    if (associated(x(b))) call abort ()
  16    allocate(b)
  17    if (associated(x(b), x(a))) call abort ()
  18
  19 contains
  20
  21   function x(a) RESULT(b)
  22     real, pointer :: a,b
  23     b => a
  24   end function x
  25
  26 end program test