| ! { dg-do run } |
| ! Tests the fix for PR40591 in which the interface 'sub2' |
| ! for 'pptr2' was not resolved. |
| ! |
| ! Contributed by Tobias Burnus <burnus@gcc.gnu.org> |
| ! |
| program main |
| call test |
| contains |
| subroutine sub1(arg) |
| integer arg |
| arg = arg + 1 |
| end subroutine sub1 |
| subroutine test() |
| procedure(sub1), pointer :: pptr1 |
| procedure(sub2), pointer :: pptr2 |
| integer i |
| i = 0 |
| pptr1 => sub1 |
| call pptr1 (i) |
| pptr1 => sub2 |
| call pptr1 (i) |
| pptr2 => sub1 |
| call pptr2 (i) |
| pptr2 => sub2 |
| call pptr2 (i) |
| if (i .ne. 22) STOP 1 |
| end subroutine test |
| subroutine sub2(arg) |
| integer arg |
| arg = arg + 10 |
| end subroutine sub2 |
| end program main |