|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! Test the fix for PR82550 in which the reference to 'p' in 'foo'
|
|
|
4 ! was not being correctly handled.
|
|
|
5 !
|
|
|
6 ! Contributed by Reinhold Bader <Bader@lrz.de>
|
|
|
7 !
|
|
|
8 module m_subm_18_pos
|
|
|
9 implicit none
|
|
|
10 integer :: i = 0
|
|
|
11 interface
|
|
|
12 module subroutine foo(fun_ptr)
|
|
|
13 procedure(p), pointer, intent(out) :: fun_ptr
|
|
|
14 end subroutine
|
|
|
15 end interface
|
|
|
16 contains
|
|
|
17 subroutine p()
|
|
|
18 i = 1
|
|
|
19 end subroutine p
|
|
|
20 end module m_subm_18_pos
|
|
|
21 submodule (m_subm_18_pos) subm_18_pos
|
|
|
22 implicit none
|
|
|
23 contains
|
|
|
24 module subroutine foo(fun_ptr)
|
|
|
25 procedure(p), pointer, intent(out) :: fun_ptr
|
|
|
26 fun_ptr => p
|
|
|
27 end subroutine
|
|
|
28 end submodule
|
|
|
29 program p_18_pos
|
|
|
30 use m_subm_18_pos
|
|
|
31 implicit none
|
|
|
32 procedure(), pointer :: x
|
|
|
33 call foo(x)
|
|
|
34 call x()
|
|
|
35 if (i == 1) then
|
|
|
36 write(*,*) 'OK'
|
|
|
37 else
|
|
|
38 write(*,*) 'FAIL'
|
|
131
|
39 STOP 1
|
|
111
|
40 end if
|
|
|
41 end program p_18_pos
|
|
|
42
|
