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))
9CONTAINS
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
21END
22
23