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
|
! { dg-do run }
!
! Checks that PR60593 is fixed (Revision: 214757)
!
! Contributed by Steve Kargl <kargl@gcc.gnu.org>
!
! Main program added for this test.
!
module stringhelper_m
implicit none
type :: string_t
character(:), allocatable :: string
end type
interface len
function strlen(s) bind(c,name='strlen')
use iso_c_binding
implicit none
type(c_ptr), intent(in), value :: s
integer(c_size_t) :: strlen
end function
end interface
contains
function C2FChar(c_charptr) result(res)
use iso_c_binding
type(c_ptr), intent(in) :: c_charptr
character(:), allocatable :: res
character(kind=c_char,len=1), pointer :: string_p(:)
integer i, c_str_len
c_str_len = int(len(c_charptr))
call c_f_pointer(c_charptr, string_p, [c_str_len])
allocate(character(c_str_len) :: res)
forall (i = 1:c_str_len) res(i:i) = string_p(i)
end function
end module
use stringhelper_m
use iso_c_binding
implicit none
type(c_ptr) :: cptr
character(20), target :: str
str = "abcdefghij"//char(0)
cptr = c_loc (str)
if (len (C2FChar (cptr)) .ne. 10) STOP 1
if (C2FChar (cptr) .ne. "abcdefghij") STOP 2
end
|
