mirror of
https://github.com/autc04/Retro68.git
synced 2024-06-28 11:30:19 +00:00
53 lines
1.2 KiB
Fortran
53 lines
1.2 KiB
Fortran
! { 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
|