gcc/testsuite/gfortran.dg/deferred_character_10.f90

   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 !
   9 module 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
  40 end 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) STOP 1
  51   if (C2FChar (cptr) .ne. "abcdefghij") STOP 2
  52 end