Skip to content

Commit 5ee6bbb

Browse files
committed
add join, to_c_string
1 parent ab744c0 commit 5ee6bbb

File tree

1 file changed

+93
-2
lines changed

1 file changed

+93
-2
lines changed

src/stdlib_strings.fypp

Lines changed: 93 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,16 +5,18 @@
55
!> The specification of this module is available [here](../page/specs/stdlib_strings.html).
66
module stdlib_strings
77
use stdlib_ascii, only: whitespace
8-
use stdlib_string_type, only: string_type, char, verify, repeat, len
8+
use stdlib_string_type, only: string_type, char, verify, repeat, len, len_trim, move
99
use stdlib_optval, only: optval
1010
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
1112
implicit none
1213
private
1314

1415
public :: to_string
16+
public :: to_c_string
1517
public :: strip, chomp
1618
public :: starts_with, ends_with
17-
public :: slice, find, replace_all, padl, padr, count, zfill
19+
public :: slice, find, replace_all, padl, padr, count, zfill, join
1820

1921
!> Version: experimental
2022
!>
@@ -164,6 +166,17 @@ module stdlib_strings
164166
module procedure :: zfill_char
165167
end interface zfill
166168

169+
!> Version: experimental
170+
!>
171+
!> Joins an array of strings into a single string.
172+
!> The chunks are separated with a space, or an optional user-defined separator.
173+
!> [Specifications](../page/specs/stdlib_strings.html#join)
174+
interface join
175+
module procedure :: join_string
176+
module procedure :: join_char
177+
end interface join
178+
179+
167180
contains
168181

169182

@@ -943,5 +956,83 @@ contains
943956

944957
end function zfill_char
945958

959+
!> Convert a Fortran character string to a C character array
960+
!>
961+
!> Version: experimental
962+
pure function to_c_string(value) result(cstr)
963+
character(len=*), intent(in) :: value
964+
character(kind=c_char) :: cstr(len(value)+1)
965+
integer :: i
966+
do concurrent (i=1:len(value))
967+
cstr(i) = value(i:i)
968+
end do
969+
cstr(len(value)+1) = c_null_char
970+
end function to_c_string
971+
972+
!> Joins a list of strings with a separator (default: space).
973+
!> Returns a new string
974+
pure function join_string(strings, separator) result(cmd)
975+
type(string_type), intent(in) :: strings(:)
976+
character(len=*), intent(in), optional :: separator
977+
type(string_type) :: cmd
978+
integer :: ltot, i, lt, pos
979+
character(len=:), allocatable :: sep,cmd_char
980+
! Determine separator: use user-provided separator or default space
981+
if (present(separator)) then
982+
sep = separator
983+
else
984+
sep = ' '
985+
end if
986+
! Calculate the total length required, including separators
987+
ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep)
988+
allocate(character(len=ltot) :: cmd_char)
989+
990+
! Concatenate strings with separator
991+
pos = 0
992+
do i = 1, size(strings)
993+
lt = len_trim(strings(i))
994+
cmd_char(pos+1:pos+lt) = char(strings(i),1,lt)
995+
pos = pos + lt
996+
if (i < size(strings)) then
997+
cmd_char(pos+1:pos+len(sep)) = sep
998+
pos = pos + len(sep)
999+
end if
1000+
end do
1001+
1002+
call move(from=cmd_char,to=cmd)
1003+
1004+
end function join_string
1005+
1006+
!> Joins a list of strings with a separator (default: space).
1007+
!> Returns a new string
1008+
pure function join_char(strings, separator) result(cmd)
1009+
character(*), intent(in) :: strings(:)
1010+
character(len=*), intent(in), optional :: separator
1011+
character(len=:), allocatable :: cmd
1012+
integer :: ltot, i, lt, pos
1013+
character(len=:), allocatable :: sep
1014+
! Determine separator: use user-provided separator or default space
1015+
if (present(separator)) then
1016+
sep = separator
1017+
else
1018+
sep = ' '
1019+
end if
1020+
! Calculate the total length required, including separators
1021+
ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep)
1022+
allocate(character(len=ltot) :: cmd)
1023+
1024+
cmd = repeat(' ',ltot)
1025+
! Concatenate strings with separator
1026+
pos = 0
1027+
do i = 1, size(strings)
1028+
lt = len_trim(strings(i))
1029+
cmd(pos+1:pos+lt) = strings(i)(1:lt)
1030+
pos = pos + lt
1031+
if (i < size(strings)) then
1032+
cmd(pos+1:pos+len(sep)) = sep
1033+
pos = pos + len(sep)
1034+
end if
1035+
end do
1036+
end function join_char
9461037

9471038
end module stdlib_strings

0 commit comments

Comments
 (0)