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