blob: fc5df1f298ea1b87aac0b91307e0b9e08d129a93 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
! { dg-do compile }
!
! PR fortran/52469
!
! This was failing as the DECL of the proc pointer "func"
! was used for the interface of the proc-pointer component "my_f_ptr"
! rather than the decl of the proc-pointer target
!
! Contributed by palott@gmail.com
!
module ExampleFuncs
implicit none
! NOTE: "func" is a procedure pointer!
pointer :: func
interface
function func (z)
real :: func
real, intent (in) :: z
end function func
end interface
type Contains_f_ptr
procedure (func), pointer, nopass :: my_f_ptr
end type Contains_f_ptr
contains
function f1 (x)
real :: f1
real, intent (in) :: x
f1 = 2.0 * x
return
end function f1
function f2 (x)
real :: f2
real, intent (in) :: x
f2 = 3.0 * x**2
return
end function f2
function fancy (func, x)
real :: fancy
real, intent (in) :: x
interface AFunc
function func (y)
real :: func
real, intent (in) ::y
end function func
end interface AFunc
fancy = func (x) + 3.3 * x
end function fancy
end module ExampleFuncs
program test_proc_ptr
use ExampleFuncs
implicit none
type (Contains_f_ptr), dimension (2) :: NewType
!NewType(1) % my_f_ptr => f1
NewType(2) % my_f_ptr => f2
!write (*, *) NewType(1) % my_f_ptr (3.0), NewType(2) % my_f_ptr (3.0)
write (6, *) NewType(2) % my_f_ptr (3.0) ! < Shall print '27.0'
stop
end program test_proc_ptr
|
