1! { dg-do run }
2!
3! PR 39630: [F03] Procedure Pointer Components with PASS
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6
7module m
8 type :: t
9  sequence
10  integer :: i
11  procedure(foo), pointer,pass(y) :: foo
12 end type t
13contains
14 subroutine foo(x,y)
15  type(t),optional :: x
16  type(t) :: y
17  if(present(x)) then
18    print *, 'foo', x%i, y%i
19    if (mod(x%i+y%i,3)/=2) call abort()
20  else
21    print *, 'foo', y%i
22    if (mod(y%i,3)/=1) call abort()
23  end if
24 end subroutine foo
25end module m
26
27use m
28type(t) :: t1, t2
29t1%i = 4
30t2%i = 7
31t1%foo => foo
32t2%foo => t1%foo
33call t1%foo()
34call t2%foo()
35call t2%foo(t1)
36end
37