gcc/testsuite/gfortran.dg/pointer_function_actual_2.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR31200, in which the target x would
   3 ! not be associated with p
   4 !
   5 ! COntributed by Joost VandeVondele <jv244@cam.ac.uk>
   6 !
   7   REAL,TARGET :: x
   8   CALL s3(f(x))
   9 CONTAINS
  10   FUNCTION f(a)
  11     REAL,POINTER :: f
  12     REAL,TARGET :: a
  13     f => a
  14   END FUNCTION
  15   SUBROUTINE s3(targ)
  16     REAL,TARGET :: targ
  17     REAL,POINTER :: p
  18     p => targ
  19     IF (.NOT. ASSOCIATED(p,x)) CALL ABORT()
  20   END SUBROUTINE
  21 END
  22