33 use,
INTRINSIC :: iso_c_binding
34 #ifdef WITH_VARYING_STRING
35 USE iso_varying_string
72 TYPE(c_ptr),
POINTER :: elem(:) => null()
73 CHARACTER(len=1),
POINTER :: buffer(:) => null()
80 MODULE PROCEDURE strlen_char, strlen_chararr, strlen_intarr, &
82 #ifdef WITH_VARYING_STRING
83 MODULE PROCEDURE strlen_var_str
110 MODULE PROCEDURE strtofchar_char, strtofchar_chararr, strtofchar_intarr, &
121 MODULE PROCEDURE c_ptr_ptr_new_from_c, c_ptr_ptr_new_from_fchar
124 INTERFACE ASSIGNMENT(=)
125 MODULE PROCEDURE strtofchararr_assign
126 END INTERFACE ASSIGNMENT(=)
135 PURE FUNCTION strlen_char(string)
RESULT(strlen)
139 CHARACTER(kind=c_char,len=*),
INTENT(in) :: string
144 DO i = 1, len(string)
145 IF (string(i:i) == char(0))
EXIT
149 END FUNCTION strlen_char
152 PURE FUNCTION strlen_chararr(string)
RESULT(strlen)
156 CHARACTER(kind=c_char,len=1),
INTENT(in) :: string(:)
161 DO i = 1,
SIZE(string)
162 IF (string(i) == char(0))
EXIT
166 END FUNCTION strlen_chararr
169 PURE FUNCTION strlen_intarr(string)
RESULT(strlen)
173 INTEGER(kind=c_signed_char),
INTENT(in) :: string(:)
178 DO i = 1,
SIZE(string)
179 IF (string(i) == 0)
EXIT
183 END FUNCTION strlen_intarr
186 FUNCTION strlen_ptr(string)
RESULT(strlen)
190 TYPE(c_ptr),
INTENT(in) :: string
193 INTEGER(kind=c_signed_char),
POINTER :: pstring(:)
196 IF (c_associated(string))
THEN
198 CALL c_f_pointer(string, pstring, (/huge(i)/))
200 DO i = 1,
SIZE(pstring)
201 IF (pstring(i) == 0)
EXIT
208 END FUNCTION strlen_ptr
211 #ifdef WITH_VARYING_STRING
212 PURE FUNCTION strlen_var_str(string)
RESULT(strlen)
216 TYPE(varying_string),
INTENT(in) :: string
221 END FUNCTION strlen_var_str
225 FUNCTION strtofchar_char(string)
RESULT(fchar)
229 CHARACTER(kind=c_char,len=*),
INTENT(in) :: string
230 CHARACTER(len=strlen(string)) :: fchar
232 fchar(:) = string(1:len(fchar))
234 END FUNCTION strtofchar_char
237 FUNCTION strtofchar_chararr(string)
RESULT(fchar)
241 CHARACTER(kind=c_char,len=1),
INTENT(in) :: string(:)
242 CHARACTER(len=strlen(string)) :: fchar
247 fchar(i:i) = string(i)
250 END FUNCTION strtofchar_chararr
253 FUNCTION strtofchar_intarr(string)
RESULT(fchar)
257 INTEGER(kind=c_signed_char),
INTENT(in) :: string(:)
258 CHARACTER(len=strlen(string)) :: fchar
260 fchar(:) = transfer(string(1:len(fchar)), fchar)
262 END FUNCTION strtofchar_intarr
286 FUNCTION strtofchar_ptr_2(string, fixlen)
RESULT(fchar)
290 TYPE(c_ptr),
INTENT(in) :: string
291 INTEGER,
INTENT(in) :: fixlen
292 CHARACTER(len=fixlen) :: fchar
294 CHARACTER(len=fixlen),
POINTER :: pfchar
297 safelen = min(
strlen(string), fixlen)
300 IF (c_associated(string))
THEN
301 CALL c_f_pointer(string, pfchar)
302 fchar(1:safelen) = pfchar(1:safelen)
305 END FUNCTION strtofchar_ptr_2
312 FUNCTION fchartostr(fchar)
RESULT(string)
316 CHARACTER(len=*),
INTENT(in) :: fchar
317 CHARACTER(kind=c_char,len=LEN(fchar)+1) :: string
319 string = fchar//char(0)
321 END FUNCTION fchartostr
329 FUNCTION fchartrimtostr(fchar)
RESULT(string)
333 CHARACTER(len=*),
INTENT(in) :: fchar
334 CHARACTER(kind=c_char,len=LEN_TRIM(fchar)+1) :: string
336 string = trim(fchar)//char(0)
338 END FUNCTION fchartrimtostr
341 SUBROUTINE strtofchararr_assign(fchar, string)
345 CHARACTER(kind=c_char,len=1),
ALLOCATABLE,
INTENT(out) :: fchar(:)
346 TYPE(c_ptr),
INTENT(in) :: string
348 CHARACTER(kind=c_char),
POINTER :: pstring(:)
352 CALL c_f_pointer(string, pstring, (/l/))
354 fchar(:) = pstring(:)
356 END SUBROUTINE strtofchararr_assign
365 FUNCTION c_ptr_ptr_new_from_c(c_ptr_ptr_c)
RESULT(this)
369 TYPE(c_ptr),
VALUE :: c_ptr_ptr_c
373 TYPE(c_ptr),
POINTER :: charp(:)
375 IF (c_associated(c_ptr_ptr_c))
THEN
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/))
385 END FUNCTION c_ptr_ptr_new_from_c
394 FUNCTION c_ptr_ptr_new_from_fchar(fchar)
RESULT(this)
395 CHARACTER(len=*) :: fchar(:)
398 INTEGER :: i, j, totlen
401 DO i = 1,
SIZE(fchar)
402 totlen = totlen + len_trim(fchar(i)) + 1
404 ALLOCATE(this%buffer(totlen), this%elem(
SIZE(fchar) + 1))
406 DO 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)
412 this%buffer(totlen) = char(0)
415 this%elem(i) = c_null_ptr
417 END FUNCTION c_ptr_ptr_new_from_fchar
423 FUNCTION c_ptr_ptr_getsize(this)
428 INTEGER :: c_ptr_ptr_getsize
430 IF (
ASSOCIATED(this%elem))
THEN
431 c_ptr_ptr_getsize =
SIZE(this%elem) - 1
433 c_ptr_ptr_getsize = 0
436 END FUNCTION c_ptr_ptr_getsize
446 FUNCTION c_ptr_ptr_getptr(this, n)
451 INTEGER,
INTENT(in) :: n
452 TYPE(c_ptr) :: c_ptr_ptr_getptr
454 c_ptr_ptr_getptr = c_null_ptr
455 IF (
ASSOCIATED(this%elem))
THEN
456 IF (n > 0 .AND. n <=
SIZE(this%elem))
THEN
457 c_ptr_ptr_getptr = this%elem(n)
461 END FUNCTION c_ptr_ptr_getptr
467 FUNCTION c_ptr_ptr_getobject(this)
469 TYPE(c_ptr) :: c_ptr_ptr_getobject
471 c_ptr_ptr_getobject = c_null_ptr
472 IF (
ASSOCIATED(this%elem))
THEN
473 c_ptr_ptr_getobject = c_loc(this%elem(1))
476 END FUNCTION c_ptr_ptr_getobject
Constructor for a c_ptr_ptr object.
Equivalent of the strlen C function.
Convert a null-terminated C string into a Fortran CHARACTER variable of the proper length.
Utility module for supporting Fortran 2003 C language interface module.
Fortran derived type for handling void**, char**, etc C objects (pointer to pointer or array of point...