1! { dg-do run }
2! Tests the fix for PR40591 in which the interface 'sub2'
3! for 'pptr2' was not resolved.
4!
5! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
6!
7program main
8  call test
9contains
10  subroutine sub1(arg)
11    integer arg
12    arg = arg + 1
13  end subroutine sub1
14  subroutine test()
15    procedure(sub1), pointer :: pptr1
16    procedure(sub2), pointer :: pptr2
17    integer i
18    i = 0
19    pptr1 => sub1
20    call pptr1 (i)
21    pptr1 => sub2
22    call pptr1 (i)
23    pptr2 => sub1
24    call pptr2 (i)
25    pptr2 => sub2
26    call pptr2 (i)
27    if (i .ne. 22) call abort
28  end subroutine test
29  subroutine sub2(arg)
30    integer arg
31    arg = arg + 10
32  end subroutine sub2
33end program main
34