1! { dg-do run }
2!
3! Checks that PR60593 is fixed (Revision: 214757)
4!
5! Contributed by Steve Kargl  <kargl@gcc.gnu.org>
6!
7! Main program added for this test.
8!
9module stringhelper_m
10
11  implicit none
12
13  type :: string_t
14     character(:), allocatable :: string
15  end type
16
17  interface len
18     function strlen(s) bind(c,name='strlen')
19       use iso_c_binding
20       implicit none
21       type(c_ptr), intent(in), value :: s
22       integer(c_size_t) :: strlen
23     end function
24  end interface
25
26  contains
27
28    function C2FChar(c_charptr) result(res)
29      use iso_c_binding
30      type(c_ptr), intent(in) :: c_charptr
31      character(:), allocatable :: res
32      character(kind=c_char,len=1), pointer :: string_p(:)
33      integer i, c_str_len
34      c_str_len = int(len(c_charptr))
35      call c_f_pointer(c_charptr, string_p, [c_str_len])
36      allocate(character(c_str_len) :: res)
37      forall (i = 1:c_str_len) res(i:i) = string_p(i)
38    end function
39
40end module
41
42  use stringhelper_m
43  use iso_c_binding
44  implicit none
45  type(c_ptr) :: cptr
46  character(20), target :: str
47
48  str = "abcdefghij"//char(0)
49  cptr = c_loc (str)
50  if (len (C2FChar (cptr)) .ne. 10) call abort
51  if (C2FChar (cptr) .ne. "abcdefghij") call abort
52end
53