|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-require-visibility "" }
|
|
|
3 !
|
|
|
4 ! PROCEDURE POINTERS without the PROCEDURE statement
|
|
|
5 !
|
|
|
6 ! Contributed by Janus Weil <janus@gcc.gnu.org>
|
|
|
7
|
|
|
8 real function e1(x)
|
|
|
9 real :: x
|
|
|
10 e1 = x * 3.0
|
|
|
11 end function
|
|
|
12
|
|
|
13 subroutine e2(a,b)
|
|
|
14 real, intent(inout) :: a
|
|
|
15 real, intent(in) :: b
|
|
|
16 a = a + b
|
|
|
17 end subroutine
|
|
|
18
|
|
|
19 program proc_ptr_3
|
|
|
20
|
|
|
21 real, external, pointer :: fp
|
|
|
22
|
|
|
23 pointer :: sp
|
|
|
24 interface
|
|
|
25 subroutine sp(a,b)
|
|
|
26 real, intent(inout) :: a
|
|
|
27 real, intent(in) :: b
|
|
|
28 end subroutine sp
|
|
|
29 end interface
|
|
|
30
|
|
|
31 real, external :: e1
|
|
|
32
|
|
|
33 interface
|
|
|
34 subroutine e2(a,b)
|
|
|
35 real, intent(inout) :: a
|
|
|
36 real, intent(in) :: b
|
|
|
37 end subroutine e2
|
|
|
38 end interface
|
|
|
39
|
|
|
40 real :: c = 1.2
|
|
|
41
|
|
|
42 fp => e1
|
|
|
43
|
|
|
44 if (abs(fp(2.5)-7.5)>0.01) call abort()
|
|
|
45
|
|
|
46 sp => e2
|
|
|
47
|
|
|
48 call sp(c,3.4)
|
|
|
49
|
|
|
50 if (abs(c-4.6)>0.01) call abort()
|
|
|
51
|
|
|
52 end
|
