FortranGIS Version 3.0
fortranc_test.F90
1PROGRAM fortranc_test
2use,INTRINSIC :: iso_c_binding
3USE fortranc
4IMPLICIT NONE
5
6! interface to functions in c_test.c
7INTERFACE
8FUNCTION return_null_charp() BIND(C)
9IMPORT
10TYPE(c_ptr) :: return_null_charp
11END FUNCTION return_null_charp
12
13FUNCTION return_empty_charp() BIND(C)
14IMPORT
15TYPE(c_ptr) :: return_empty_charp
16END FUNCTION return_empty_charp
17
18FUNCTION return_8_charp() BIND(C)
19IMPORT
20TYPE(c_ptr) :: return_8_charp
21END FUNCTION return_8_charp
22
23FUNCTION return_c_ptr_ptr() BIND(C)
24IMPORT
25TYPE(c_ptr) :: return_c_ptr_ptr
26END FUNCTION return_c_ptr_ptr
27END INTERFACE
28
29TYPE(c_ptr_ptr) :: strarrp
30INTEGER :: i
31
32
33! ==== How to use strlen for a char* null-terminated C string ====
34
35print*,'Testing strlen with C char* argument'
36! A NULL pointer should return zero (not obvious, for safety)
37IF (strlen(return_null_charp()) /= 0) THEN
38 print*,'Error in strlen: a NULL char* does not return zero, ', &
39 strlen(return_null_charp())
40 stop 1
41ENDIF
42! A zero-len string should return zero (obvious)
43IF (strlen(return_empty_charp()) /= 0) THEN
44 print*,'Error in strlen: a zero len char* does not return zero, ', &
45 strlen(return_empty_charp())
46 stop 1
47ENDIF
48! A 8-char string should return 8 (obvious)
49IF (strlen(return_8_charp()) /= 8) THEN
50 print*,'Error in strlen: a nonzero len char* does not return expected len (8), ', &
51 strlen(return_8_charp())
52 stop 1
53ENDIF
54
55print*,'Strlen returns the expected values'
56
57
58! ==== How to use c_ptr_ptr for decoding a char** object received from C ====
59
60! get a char** object from C function return_c_ptr_ptr(), the function
61! result has been declared as:
62! char* var[4] = { "first", "segundo", "troisieme", NULL }
63print*,'Getting a c_ptr_ptr object from C'
64strarrp = c_ptr_ptr_new(return_c_ptr_ptr())
65!IF (.NOT.C_ASSOCIATED(strarrp)) THEN
66! PRINT*,'Error in c_ptr_ptr_new, got a NULL pointer'
67!ENDIF
68
69! get the number of valid pointers in strarrp
70print*,'The object has ',c_ptr_ptr_getsize(strarrp),' elements'
71IF (c_ptr_ptr_getsize(strarrp) /= 3) THEN
72 print*,'Error in c_ptr_ptr_getsize:',3,c_ptr_ptr_getsize(strarrp)
73 stop 1
74ENDIF
75
76! get the content of selected pointers as a Fortran CHARACTER variable
77! of the right length, count starts from 1
78IF (strtofchar(c_ptr_ptr_getptr(strarrp, 1),100) /= 'first') THEN
79 print*,'Error in c_ptr_ptr_getptr:',strtofchar(c_ptr_ptr_getptr(strarrp, 1),100),':first'
80 stop 1
81ENDIF
82IF (strtofchar(c_ptr_ptr_getptr(strarrp, 2),100) /= 'segundo') THEN
83 print*,'Error in c_ptr_ptr_getptr:',strtofchar(c_ptr_ptr_getptr(strarrp, 2),100),':segundo'
84 stop 1
85ENDIF
86IF (strtofchar(c_ptr_ptr_getptr(strarrp, 3),100) /= 'troisieme') THEN
87 print*,'Error in c_ptr_ptr_getptr:',strtofchar(c_ptr_ptr_getptr(strarrp, 3),100),':troisieme'
88 stop 1
89ENDIF
90IF (strtofchar(c_ptr_ptr_getptr(strarrp, 4),100) /= '') THEN
91 print*,'Error in c_ptr_ptr_getptr: out of bound request should return empty string:',strtofchar(c_ptr_ptr_getptr(strarrp, 4),100)
92 stop 1
93ENDIF
94
95print*,'The object contains the expected data'
96
97
98! ==== How to use c_ptr_ptr for creating a char** object and pass it to C ====
99
100! create a char** object from a Fortran array of characters
101print*,'Creating a c_ptr_ptr object from a Fortran array of characters'
102strarrp = c_ptr_ptr_new((/'first ','segundo ','troisieme'/))
103! strarrp is now ready to be passed to an interfaced C procedure
104! expecting a char** variable
105
106! we check it as before
107! get the number of valid pointers in strarrp
108print*,'The object has ',c_ptr_ptr_getsize(strarrp),' elements'
109IF (c_ptr_ptr_getsize(strarrp) /= 3) THEN
110 print*,'Error in c_ptr_ptr_getsize:',3,c_ptr_ptr_getsize(strarrp)
111 stop 1
112ENDIF
113
114! get the content of selected pointers as a Fortran CHARACTER variable
115! of the right length, count starts from 1
116IF (strtofchar(c_ptr_ptr_getptr(strarrp, 1),100) /= 'first') THEN
117 print*,'Error in c_ptr_ptr_getptr:',strtofchar(c_ptr_ptr_getptr(strarrp, 1),100),':first'
118 stop 1
119ENDIF
120IF (strtofchar(c_ptr_ptr_getptr(strarrp, 2),100) /= 'segundo') THEN
121 print*,'Error in c_ptr_ptr_getptr:',strtofchar(c_ptr_ptr_getptr(strarrp, 2),100),':segundo'
122 stop 1
123ENDIF
124IF (strtofchar(c_ptr_ptr_getptr(strarrp, 3),100) /= 'troisieme') THEN
125 print*,'Error in c_ptr_ptr_getptr:',strtofchar(c_ptr_ptr_getptr(strarrp, 3),100),':troisieme'
126 stop 1
127ENDIF
128IF (strtofchar(c_ptr_ptr_getptr(strarrp, 4),100) /= '') THEN
129 print*,'Error in c_ptr_ptr_getptr: out of bound request should return empty string:',strtofchar(c_ptr_ptr_getptr(strarrp, 4),100)
130 stop 1
131ENDIF
132
133print*,'The object contains the expected data'
134
135
136END PROGRAM fortranc_test
Constructor for a c_ptr_ptr object.
Definition fortranc.F90:185
Equivalent of the strlen C function.
Definition fortranc.F90:147
Convert a null-terminated C string into a Fortran CHARACTER variable of the proper length.
Definition fortranc.F90:174
Utility module for supporting Fortran 2003 C language interface module.
Definition fortranc.F90:103