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