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)) STOP 1
   9    allocate(a)
  10    if(associated(b,a)) STOP 2
  11    if (.not.associated(x(a))) STOP 3
  12    if (.not.associated(a, x(a))) STOP 4
  13
  14    nullify(b)
  15    if (associated(x(b))) STOP 5
  16    allocate(b)
  17    if (associated(x(b), x(a))) STOP 6
  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