FortranGIS Version 3.0
fortranc.F90
1! Copyright 2011 Davide Cesari <dcesari69 at gmail dot com>
2!
3! This file is part of FortranGIS.
4!
5! FortranGIS is free software: you can redistribute it and/or modify
6! it under the terms of the GNU Lesser General Public License as
7! published by the Free Software Foundation, either version 3 of the
8! License, or (at your option) any later version.
9!
10! FortranGIS is distributed in the hope that it will be useful, but
11! WITHOUT ANY WARRANTY; without even the implied warranty of
12! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13! Lesser General Public License for more details.
14!
15! You should have received a copy of the GNU Lesser General Public
16! License along with FortranGIS. If not, see
17! <http://www.gnu.org/licenses/>.
18#include "config.h"
19
20!> Utility module for supporting Fortran 2003 C language interface module.
21!! This module contains various utilties for simplifying the exchange
22!! of character variables between Fortran and C when using the
23!! <tt>ISO_C_BINDING</tt> intrinsic module of Fortran 2003.
24!!
25!! For an example of application of the \a fortranc module, please
26!! refer to the following test program, which, among the other
27!! operations, decodes the output of a C function returning a
28!! <tt>char**</tt> result:
29!! \include fortranc_test.F90
30!!
31!! \ingroup libfortranc
32MODULE fortranc
33use,INTRINSIC :: iso_c_binding
34#ifdef WITH_VARYING_STRING
35USE iso_varying_string
36#endif
37IMPLICIT NONE
38
39
40!> Fortran derived type for handling <tt>void**</tt>, <tt>char**</tt>,
41!! etc C objects (pointer to pointer or array of pointers). The array
42!! of pointers is assumed to be terminated by a <tt>NULL</tt>
43!! pointer. Each pointer of the array typically points to a
44!! null-terminated string, although this is not always the
45!! case. Methods are provided both for receiving the data structure
46!! from C and unpacking it in Fortran as well as for creating it in
47!! Fortran and passing it to C.
48!!
49!! Example of <tt>char**</tt> object created in C and unpacked in Fortran:
50!! \code
51!! TYPE(c_ptr_ptr) :: envp
52!! INTEGER :: i
53!! ...
54!! envp = c_ptr_ptr_new(interfaced_c_procedure())
55!! DO i = 1, c_ptr_ptr_getsize(envp)
56!! PRINT*,i,TRIM(strtofchar(c_ptr_ptr_getptr(envp, i),100))
57!! ENDDO
58!! CALL delete(envp)
59!! \endcode
60!!
61!! Example of <tt>char**</tt> object created in Fortran and passed to C:
62!! \code
63!! TYPE(c_ptr_ptr) :: envp
64!! ...
65!! envp = c_ptr_ptr_new((/'APPLE=3 ','PEAR=2 ','ORANGE=20'/))
66!! CALL interfaced_c_procedure(c_ptr_ptr_getobject(envp))
67!! CALL delete(envp)
68!! ...
69!! \endcode
70TYPE c_ptr_ptr
71 PRIVATE
72 TYPE(c_ptr),POINTER :: elem(:) => null()
73 CHARACTER(len=1),POINTER :: buffer(:) => null()
74END TYPE c_ptr_ptr
75
76!> Equivalent of the strlen C function.
77!!
78!! \param string null-terminated C-style string to test
79INTERFACE strlen
80 MODULE PROCEDURE strlen_char, strlen_chararr, strlen_intarr, &
81 strlen_ptr
82#ifdef WITH_VARYING_STRING
83 MODULE PROCEDURE strlen_var_str
84#endif
85END INTERFACE
86
87!> Convert a null-terminated C string into a Fortran <tt>CHARACTER</tt>
88!! variable of the proper length. The input can be provided as a
89!! Fortran <tt>CHARACTER</tt> scalar of any length, as a Fortran array
90!! of <tt>CHARACTER</tt> of length one, as an array of 1-byte integers or as
91!! a C pointer to char (<tt>char*</tt>).
92!!
93!! It is typically used for:
94!!
95!! - converting a string created/modified by a C function and passed
96!! as a <tt>char *</tt> argument, interfaced as
97!! <tt>CHARACTER(kind=c_char,len=*) :: fchar</tt> for its
98!! subsequent use in Fortran
99!!
100!! - (more frequently) converting a string returned by a C function
101!! declared as <tt>char*</tt>, interfaced as <tt>TYPE(c_ptr)</tt>
102!! for its subsequent use in Fortran
104!! - converting a string contained in an C-interoperable derived
105!! type, declared in C as <tt>char*</tt>, interfaced as
106!! <tt>TYPE(c_ptr)</tt> for its subsequent use in Fortran
107!!
108!! \param string null-terminated C-style string to convert
109INTERFACE strtofchar
110 MODULE PROCEDURE strtofchar_char, strtofchar_chararr, strtofchar_intarr, &
111 strtofchar_ptr_2
112END INTERFACE
113
114!> Constructor for a \a c_ptr_ptr object.
115!! An object of this type can be constructed either from a pointer
116!! returned by a C procedure, (either as an argument, interfaced as
117!! <tt>TYPE(c_ptr),VALUE</tt> or as the result of a function,
118!! interfaced as <tt>TYPE(c_ptr)</tt>) or from Fortran array of
119!! character variables (<tt>char **</tt> objects only).
120INTERFACE c_ptr_ptr_new
121 MODULE PROCEDURE c_ptr_ptr_new_from_c, c_ptr_ptr_new_from_fchar
122END INTERFACE c_ptr_ptr_new
123
124INTERFACE ASSIGNMENT(=)
125 MODULE PROCEDURE strtofchararr_assign
126END INTERFACE ASSIGNMENT(=)
127
128PRIVATE
129PUBLIC strlen, strtofchar, fchartostr, fchartrimtostr, ASSIGNMENT(=)
130PUBLIC c_ptr_ptr, c_ptr_ptr_new, c_ptr_ptr_getsize, c_ptr_ptr_getptr, c_ptr_ptr_getobject
131
132CONTAINS
133
134
135PURE FUNCTION strlen_char(string) RESULT(strlen)
136#ifdef DLL_EXPORT
137!GCC$ ATTRIBUTES DLLEXPORT :: strlen_char
138#endif
139CHARACTER(kind=c_char,len=*),INTENT(in) :: string
140INTEGER :: strlen
141
142INTEGER :: i
143
144DO i = 1, len(string)
145 IF (string(i:i) == char(0)) EXIT
146ENDDO
147strlen = i - 1
148
149END FUNCTION strlen_char
150
151
152PURE FUNCTION strlen_chararr(string) RESULT(strlen)
153#ifdef DLL_EXPORT
154!GCC$ ATTRIBUTES DLLEXPORT :: strlen_chararr
155#endif
156CHARACTER(kind=c_char,len=1),INTENT(in) :: string(:)
157INTEGER :: strlen
158
159INTEGER :: i
160
161DO i = 1, SIZE(string)
162 IF (string(i) == char(0)) EXIT
163ENDDO
164strlen = i - 1
165
166END FUNCTION strlen_chararr
167
168
169PURE FUNCTION strlen_intarr(string) RESULT(strlen)
170#ifdef DLL_EXPORT
171!GCC$ ATTRIBUTES DLLEXPORT :: strlen_intarr
172#endif
173INTEGER(kind=c_signed_char),INTENT(in) :: string(:)
174INTEGER :: strlen
175
176INTEGER :: i
177
178DO i = 1, SIZE(string)
179 IF (string(i) == 0) EXIT
180ENDDO
181strlen = i - 1
182
183END FUNCTION strlen_intarr
184
186FUNCTION strlen_ptr(string) RESULT(strlen)
187#ifdef DLL_EXPORT
188!GCC$ ATTRIBUTES DLLEXPORT :: strlen_ptr
189#endif
190TYPE(c_ptr),INTENT(in) :: string
191INTEGER :: strlen
192
193INTEGER(kind=c_signed_char),POINTER :: pstring(:)
194INTEGER :: i
195
196IF (c_associated(string)) THEN ! conflicts with PURE
197! null C pointer does not produce unassociated Fortran pointer with Intel
198 CALL c_f_pointer(string, pstring, (/huge(i)/))
199! IF (ASSOCIATED(pstring)) THEN
200 DO i = 1, SIZE(pstring)
201 IF (pstring(i) == 0) EXIT
202 ENDDO
203 strlen = i - 1
204ELSE
205 strlen = 0
206ENDIF
207
208END FUNCTION strlen_ptr
209
210
211#ifdef WITH_VARYING_STRING
212PURE FUNCTION strlen_var_str(string) RESULT(strlen)
213#ifdef DLL_EXPORT
214!GCC$ ATTRIBUTES DLLEXPORT :: strlen_var_str
215#endif
216TYPE(varying_string),INTENT(in) :: string
217INTEGER :: strlen
218
219strlen = len(string)
220
221END FUNCTION strlen_var_str
222#endif
223
224
225FUNCTION strtofchar_char(string) RESULT(fchar)
226#ifdef DLL_EXPORT
227!GCC$ ATTRIBUTES DLLEXPORT :: strtofchar_char
228#endif
229CHARACTER(kind=c_char,len=*),INTENT(in) :: string
230CHARACTER(len=strlen(string)) :: fchar
231
232fchar(:) = string(1:len(fchar))
233
234END FUNCTION strtofchar_char
235
236
237FUNCTION strtofchar_chararr(string) RESULT(fchar)
238#ifdef DLL_EXPORT
239!GCC$ ATTRIBUTES DLLEXPORT :: strtofchar_chararr
240#endif
241CHARACTER(kind=c_char,len=1),INTENT(in) :: string(:)
242CHARACTER(len=strlen(string)) :: fchar
243
244INTEGER :: i
245
246DO i = 1, len(fchar)
247 fchar(i:i) = string(i)
248ENDDO
249
250END FUNCTION strtofchar_chararr
251
252
253FUNCTION strtofchar_intarr(string) RESULT(fchar)
254#ifdef DLL_EXPORT
255!GCC$ ATTRIBUTES DLLEXPORT :: strtofchar_intarr
256#endif
257INTEGER(kind=c_signed_char),INTENT(in) :: string(:)
258CHARACTER(len=strlen(string)) :: fchar
259
260fchar(:) = transfer(string(1:len(fchar)), fchar)
261
262END FUNCTION strtofchar_intarr
263
264
265! this unfortunately works only with gfortran where c_f_pointer is
266! "erroneously" declared as PURE thus strlen_ptr can be PURE as well
267
268!FUNCTION strtofchar_ptr(string) RESULT(fchar)
269!TYPE(c_ptr),INTENT(in) :: string
270!CHARACTER(len=strlen(string)) :: fchar
271!
272!CHARACTER(len=strlen(string)),POINTER :: pfchar
273!
274!IF (C_ASSOCIATED(string)) THEN
275! CALL c_f_pointer(string, pfchar)
276! fchar(:) = pfchar(:)
277!!ELSE
278!! silently return an empty string probably useless because
279!! strlen is zero in this case (to be tested)
280!! fchar = ''
281!ENDIF
282!
283!END FUNCTION strtofchar_ptr
284
285
286FUNCTION strtofchar_ptr_2(string, fixlen) RESULT(fchar)
287#ifdef DLL_EXPORT
288!GCC$ ATTRIBUTES DLLEXPORT :: strtofchar_ptr_2
289#endif
290TYPE(c_ptr),INTENT(in) :: string
291INTEGER,INTENT(in) :: fixlen
292CHARACTER(len=fixlen) :: fchar
293
294CHARACTER(len=fixlen),POINTER :: pfchar
295INTEGER :: safelen
296
297safelen = min(strlen(string), fixlen)
298
299fchar = ''
300IF (c_associated(string)) THEN
301 CALL c_f_pointer(string, pfchar)
302 fchar(1:safelen) = pfchar(1:safelen)
303ENDIF
304
305END FUNCTION strtofchar_ptr_2
306
307
308!> Convert a Fortran \a CHARACTER variable into a null-terminated C
309!! string. The result is still of type \a CHARACTER but it is
310!! interoperable with a C null-terminated string argument <tt>const
311!! char*</tt> interfaced as <tt>CHARACTER(kind=c_char) :: cstr</tt>.
312FUNCTION fchartostr(fchar) RESULT(string)
313#ifdef DLL_EXPORT
314!GCC$ ATTRIBUTES DLLEXPORT :: fchartostr
315#endif
316CHARACTER(len=*),INTENT(in) :: fchar !< Fortran \a CHARACTER variable to convert
317CHARACTER(kind=c_char,len=LEN(fchar)+1) :: string
318
319string = fchar//char(0)
320
321END FUNCTION fchartostr
322
323
324!> Trim trailing blanks and convert a Fortran \a CHARACTER variable
325!! into a null-terminated C string. The result is still of type \a
326!! CHARACTER but it is interoperable with a C null-terminated string
327!! argument <tt>const char*</tt> interfaced as
328!! <tt>CHARACTER(kind=c_char) :: cstr</tt>.
329FUNCTION fchartrimtostr(fchar) RESULT(string)
330#ifdef DLL_EXPORT
331!GCC$ ATTRIBUTES DLLEXPORT :: fchartrimtostr
332#endif
333CHARACTER(len=*),INTENT(in) :: fchar !< Fortran \a CHARACTER variable to convert
334CHARACTER(kind=c_char,len=LEN_TRIM(fchar)+1) :: string
335
336string = trim(fchar)//char(0)
337
338END FUNCTION fchartrimtostr
339
340
341SUBROUTINE strtofchararr_assign(fchar, string)
342#ifdef DLL_EXPORT
343!GCC$ ATTRIBUTES DLLEXPORT :: strtofchararr_assign
344#endif
345CHARACTER(kind=c_char,len=1),ALLOCATABLE,INTENT(out) :: fchar(:)
346TYPE(c_ptr),INTENT(in) :: string
347
348CHARACTER(kind=c_char),POINTER :: pstring(:)
349INTEGER :: l
350
351l = strlen(string)
352CALL c_f_pointer(string, pstring, (/l/))
353ALLOCATE(fchar(l))
354fchar(:) = pstring(:)
356END SUBROUTINE strtofchararr_assign
357
358
359!> Constructor for a \a c_ptr_ptr object.
360!! The argument, a generic C pointer, must be a C array of pointers
361!! (<tt>char** c_ptr_ptr_c</tt> or <tt>char* c_ptr_ptr_c[n]</tt>),
362!! typically the result of a C function. The resulting object can be
363!! queried by means of the \a c_ptr_ptr_getsize and \a
364!! c_ptr_ptr_getptr methods, but it should not be modified by Fortran.
365FUNCTION c_ptr_ptr_new_from_c(c_ptr_ptr_c) RESULT(this)
366#ifdef DLL_EXPORT
367!GCC$ ATTRIBUTES DLLEXPORT :: c_ptr_ptr_new_from_c
368#endif
369TYPE(c_ptr),VALUE :: c_ptr_ptr_c !< pointer returned by a C procedure
370TYPE(c_ptr_ptr) :: this
371
372INTEGER :: i
373TYPE(c_ptr),POINTER :: charp(:)
374
375IF (c_associated(c_ptr_ptr_c)) THEN
376 ! HUGE() here is ugly, but we must set a finite size
377 CALL c_f_pointer(c_ptr_ptr_c, charp, (/huge(1)/))
378 DO i = 1, SIZE(charp)
379 IF (.NOT.c_associated(charp(i))) THEN
380 CALL c_f_pointer(c_ptr_ptr_c, this%elem, (/i/))
381 RETURN
382 ENDIF
383 ENDDO
384ENDIF
385END FUNCTION c_ptr_ptr_new_from_c
386
387
388!> Constructor for a \a c_ptr_ptr object.
389!! The argument is an array of Fortran character variables which will
390!! be trimmed and stored in the resulting object. The object can be
391!! passed to a C procedure as a <tt>char **</tt> argument after
392!! applying the \a c_ptr_prt_getptr method, but it should not be
393!! modified by the C procedure.
394FUNCTION c_ptr_ptr_new_from_fchar(fchar) RESULT(this)
395CHARACTER(len=*) :: fchar(:) !< array of characters that will compose the object
396TYPE(c_ptr_ptr) :: this
397
398INTEGER :: i, j, totlen
399
400totlen = 0
401DO i = 1, SIZE(fchar)
402 totlen = totlen + len_trim(fchar(i)) + 1
403ENDDO
404ALLOCATE(this%buffer(totlen), this%elem(SIZE(fchar) + 1))
405totlen = 1
406DO i = 1, SIZE(fchar)
407 this%elem(i) = c_loc(this%buffer(totlen))
408 DO j = 1, len_trim(fchar(i))
409 this%buffer(totlen) = fchar(i)(j:j)
410 totlen = totlen + 1
411 ENDDO
412 this%buffer(totlen) = char(0)
413 totlen = totlen + 1
414ENDDO
415this%elem(i) = c_null_ptr
416
417END FUNCTION c_ptr_ptr_new_from_fchar
418
419
420!> Return the number of valid pointers in the array pointer \a this.
421!! If the object has not been initialized or has been initialized with
422!! errors, zero is returned.
423FUNCTION c_ptr_ptr_getsize(this)
424#ifdef DLL_EXPORT
425!GCC$ ATTRIBUTES DLLEXPORT :: c_ptr_ptr_getsize
426#endif
427TYPE(c_ptr_ptr),INTENT(in) :: this
428INTEGER :: c_ptr_ptr_getsize
429
430IF (ASSOCIATED(this%elem)) THEN
431 c_ptr_ptr_getsize = SIZE(this%elem) - 1
432ELSE
433 c_ptr_ptr_getsize = 0
434ENDIF
435
436END FUNCTION c_ptr_ptr_getsize
437
438!> Return the n-th pointer in the array pointer \a this.
439!! Ths method is useful if the object \a this has been created from C.
440!! If the object has not been initialized, or \a n is out of bounds, a
441!! NULL pointer is returned, this condition can be checked by means of
442!! the <tt>C_ASSOCIATED()</tt> function. If \a this is an array of
443!! pointers to C null-terminated strings, the string can be returned
444!! as a Fortran \a CHARACTER variable of the proper length by using
445!! the \a strtofchar function.
446FUNCTION c_ptr_ptr_getptr(this, n)
447#ifdef DLL_EXPORT
448!GCC$ ATTRIBUTES DLLEXPORT :: c_ptr_ptr_getptr
449#endif
450TYPE(c_ptr_ptr),INTENT(in) :: this !< object to query
451INTEGER,INTENT(in) :: n !< the number of pointer to get (starting from 1)
452TYPE(c_ptr) :: c_ptr_ptr_getptr
453
454c_ptr_ptr_getptr = c_null_ptr
455IF (ASSOCIATED(this%elem)) THEN
456 IF (n > 0 .AND. n <= SIZE(this%elem)) THEN
457 c_ptr_ptr_getptr = this%elem(n)
458 ENDIF
459ENDIF
461END FUNCTION c_ptr_ptr_getptr
462
463
464!> Return the C pointer to the first pointer in the array pointer \a this.
465!! This method is useful if the object \a this has been created from
466!! Fortran and it has to be passed to a C procedure.
467FUNCTION c_ptr_ptr_getobject(this)
468TYPE(c_ptr_ptr),INTENT(in) :: this !< object to query
469TYPE(c_ptr) :: c_ptr_ptr_getobject
470
471c_ptr_ptr_getobject = c_null_ptr
472IF (ASSOCIATED(this%elem)) THEN
473 c_ptr_ptr_getobject = c_loc(this%elem(1))
474ENDIF
475
476END FUNCTION c_ptr_ptr_getobject
477
478END MODULE fortranc
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
Fortran derived type for handling void**, char**, etc C objects (pointer to pointer or array of point...
Definition fortranc.F90:138