1! { dg-do run }
2!
3! PR fortran/52585
4!
5! Test proc-pointer dummies with ASSOCIATE
6!
7! Contributed by Mat Cross of NAG
8!
9module m0
10  abstract interface
11    subroutine sub
12    end subroutine sub
13  end interface
14  interface
15    subroutine s(ss, isassoc)
16      import sub
17      logical :: isassoc
18      procedure(sub), pointer, intent(in) :: ss
19    end subroutine s
20  end interface
21end module m0
22
23use m0, only : sub, s
24procedure(sub) :: sub2, pp
25pointer :: pp
26pp => sub2
27if (.not. associated(pp)) call abort ()
28if (.not. associated(pp,sub2)) call abort ()
29call s(pp, .true.)
30pp => null()
31if (associated(pp)) call abort ()
32if (associated(pp,sub2)) call abort ()
33call s(pp, .false.)
34end
35
36subroutine s(ss, isassoc)
37  use m0, only : sub
38  logical :: isassoc
39  procedure(sub), pointer, intent(in) :: ss
40  procedure(sub) :: sub2
41  if (isassoc .neqv. associated(ss)) call abort ()
42  if (isassoc .neqv. associated(ss,sub2)) call abort ()
43end subroutine s
44
45subroutine sub2
46end subroutine sub2
47