2 use,
INTRINSIC :: iso_c_binding
8 FUNCTION return_null_charp()
BIND(C)
10 TYPE(c_ptr) :: return_null_charp
11 END FUNCTION return_null_charp
13 FUNCTION return_empty_charp()
BIND(C)
15 TYPE(c_ptr) :: return_empty_charp
16 END FUNCTION return_empty_charp
18 FUNCTION return_8_charp()
BIND(C)
20 TYPE(c_ptr) :: return_8_charp
21 END FUNCTION return_8_charp
23 FUNCTION return_c_ptr_ptr()
BIND(C)
25 TYPE(c_ptr) :: return_c_ptr_ptr
26 END FUNCTION return_c_ptr_ptr
29 TYPE(c_ptr_ptr) :: strarrp
35 print*,
'Testing strlen with C char* argument'
37 IF (
strlen(return_null_charp()) /= 0)
THEN
38 print*,
'Error in strlen: a NULL char* does not return zero, ', &
39 strlen(return_null_charp())
43 IF (
strlen(return_empty_charp()) /= 0)
THEN
44 print*,
'Error in strlen: a zero len char* does not return zero, ', &
45 strlen(return_empty_charp())
49 IF (
strlen(return_8_charp()) /= 8)
THEN
50 print*,
'Error in strlen: a nonzero len char* does not return expected len (8), ', &
55 print*,
'Strlen returns the expected values'
63 print*,
'Getting a c_ptr_ptr object from C'
70 print*,
'The object has ',c_ptr_ptr_getsize(strarrp),
' elements'
71 IF (c_ptr_ptr_getsize(strarrp) /= 3)
THEN
72 print*,
'Error in c_ptr_ptr_getsize:',3,c_ptr_ptr_getsize(strarrp)
78 IF (
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'
82 IF (
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'
86 IF (
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'
90 IF (
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)
95 print*,
'The object contains the expected data'
101 print*,
'Creating a c_ptr_ptr object from a Fortran array of characters'
108 print*,
'The object has ',c_ptr_ptr_getsize(strarrp),
' elements'
109 IF (c_ptr_ptr_getsize(strarrp) /= 3)
THEN
110 print*,
'Error in c_ptr_ptr_getsize:',3,c_ptr_ptr_getsize(strarrp)
116 IF (
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'
120 IF (
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'
124 IF (
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'
128 IF (
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)
133 print*,
'The object contains the expected data'
136 END PROGRAM fortranc_test
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.