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
78
79
80
81
82
83
84
85
86
|
! { dg-do compile }
!
! PR fortran/37829
!
! Contributed by James Van Buskirk and Jerry DeLisle.
!
! Fix derived-type loading with ISO_BIND_C's C_PTR/C_FUNPTR.
module m3
use ISO_C_BINDING
implicit none
private
public kill_C_PTR
interface
function kill_C_PTR() bind(C)
import
implicit none
type(C_PTR) kill_C_PTR
end function kill_C_PTR
end interface
public kill_C_FUNPTR
interface
function kill_C_FUNPTR() bind(C)
import
implicit none
type(C_FUNPTR) kill_C_FUNPTR
end function kill_C_FUNPTR
end interface
end module m3
module m1
use m3
end module m1
program X
use m1
use ISO_C_BINDING
implicit none
type(C_PTR) cp
type(C_FUNPTR) fp
integer(C_INT),target :: i
interface
function fun() bind(C)
use ISO_C_BINDING
implicit none
real(C_FLOAT) fun
end function fun
end interface
cp = C_NULL_PTR
cp = C_LOC(i)
fp = C_NULL_FUNPTR
fp = C_FUNLOC(fun)
end program X
function fun() bind(C)
use ISO_C_BINDING
implicit none
real(C_FLOAT) fun
fun = 1.0
end function fun
function kill_C_PTR() bind(C)
use ISO_C_BINDING
implicit none
type(C_PTR) kill_C_PTR
integer(C_INT), pointer :: p
allocate(p)
kill_C_PTR = C_LOC(p)
end function kill_C_PTR
function kill_C_FUNPTR() bind(C)
use ISO_C_BINDING
implicit none
type(C_FUNPTR) kill_C_FUNPTR
interface
function fun() bind(C)
use ISO_C_BINDING
implicit none
real(C_FLOAT) fun
end function fun
end interface
kill_C_FUNPTR = C_FUNLOC(fun)
end function kill_C_FUNPTR
|
