Skip to content

Commit 311d918

Browse files
committed
add type(string_type) version
1 parent 5ee6bbb commit 311d918

File tree

2 files changed

+33
-9
lines changed

2 files changed

+33
-9
lines changed

src/stdlib_kinds.fypp

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,10 @@
44
!> The specification of this module is available [here](../page/specs/stdlib_kinds.html).
55
module stdlib_kinds
66
use iso_fortran_env, only: int8, int16, int32, int64
7-
use iso_c_binding, only: c_bool
7+
use iso_c_binding, only: c_bool, c_char
88
implicit none
99
private
10-
public :: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool
10+
public :: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool, c_char
1111

1212
!> Single precision real numbers
1313
integer, parameter :: sp = selected_real_kind(6)

src/stdlib_strings.fypp

Lines changed: 31 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,8 @@ module stdlib_strings
77
use stdlib_ascii, only: whitespace
88
use stdlib_string_type, only: string_type, char, verify, repeat, len, len_trim, move
99
use stdlib_optval, only: optval
10-
use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool
11-
use iso_c_binding, only: c_char, c_null_char
10+
use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool, c_char
11+
use iso_c_binding, only: c_null_char
1212
implicit none
1313
private
1414

@@ -45,6 +45,15 @@ module stdlib_strings
4545
#:endfor
4646
end interface to_string
4747

48+
!> Version: experimental
49+
!>
50+
!> Format or transfer other types as a string.
51+
!> ([Specification](../page/specs/stdlib_strings.html#to_c_string))
52+
interface to_c_string
53+
module procedure to_c_string_from_char
54+
module procedure to_c_string_from_string
55+
end interface to_c_string
56+
4857
!> Remove leading and trailing whitespace characters.
4958
!>
5059
!> Version: experimental
@@ -959,15 +968,30 @@ contains
959968
!> Convert a Fortran character string to a C character array
960969
!>
961970
!> Version: experimental
962-
pure function to_c_string(value) result(cstr)
971+
pure function to_c_string_from_char(value) result(cstr)
963972
character(len=*), intent(in) :: value
964973
character(kind=c_char) :: cstr(len(value)+1)
965-
integer :: i
966-
do concurrent (i=1:len(value))
974+
integer :: i,lv
975+
lv = len(value)
976+
do concurrent (i=1:lv)
967977
cstr(i) = value(i:i)
968978
end do
969-
cstr(len(value)+1) = c_null_char
970-
end function to_c_string
979+
cstr(lv+1) = c_null_char
980+
end function to_c_string_from_char
981+
982+
!> Convert a Fortran string type to a C character array
983+
!>
984+
!> Version: experimental
985+
pure function to_c_string_from_string(value) result(cstr)
986+
type(string_type), intent(in) :: value
987+
character(kind=c_char) :: cstr(len(value)+1)
988+
integer :: i,lv
989+
lv = len(value)
990+
do concurrent (i=1:lv)
991+
cstr(i) = char(value,pos=i)
992+
end do
993+
cstr(lv+1) = c_null_char
994+
end function to_c_string_from_string
971995

972996
!> Joins a list of strings with a separator (default: space).
973997
!> Returns a new string

0 commit comments

Comments
 (0)