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    allocate(a)
   8    if (.not.associated(x(a))) call abort ()
   9    if (.not.associated(a, x(a))) call abort ()
  10
  11    nullify(b)
  12    if (associated(x(b))) call abort ()
  13    allocate(b)
  14    if (associated(x(b), x(a))) call abort ()
  15
  16 contains
  17
  18   function x(a) RESULT(b)
  19     real, pointer :: a,b
  20     b => a
  21   end function x
  22
  23 end program test