From ab744c0b3d9e016d3ece6427542a70f0d3390cf0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 08:25:41 +0100 Subject: [PATCH 01/14] document `join`, `to_c_string` --- doc/specs/stdlib_strings.md | 73 +++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 099aa5521..0c61907ee 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -459,6 +459,49 @@ The result is of the same type as `string`. {!example/strings/example_zfill.f90!} ``` + +### `join` + +#### Description + +Joins an array of strings into a single string. This function concatenates the strings from the input array, +inserting a separator between each string (default: space). A user-defined separator may be provided, The resulting string is returned. + + +#### Syntax + +`cmd = ` [[stdlib_strings(module):join(interface)]] ` (strings, separator)` + +#### Status + +Experimental + +#### Class + +Pure function + +#### Argument + +- `strings`: Array of strings (either `type(string_type)` or `character(len=*)`). + This argument is `intent(in)`. It is an array of strings that will be concatenated together. +- `separator`: Character scalar (optional). + This argument is `intent(in)`. It specifies the separator to be used between the strings. If not provided, the default separator (a space) is used. + +#### Result value + +The result is of the same type as the elements of `strings` (`type(string_type)` or `character(len=:), allocatable`). + +#### Example + +```fortran +! Example usage: +program test_join + type(string_type) :: result + type(string_type), dimension(3) :: words = [string_type('hello'), string_type('world'), string_type('fortran')] + result = join_string(words, ', ') ! Joins with comma and space + print *, result ! Output: "hello, world, fortran" +end program test_join +``` ### `to_string` @@ -498,3 +541,33 @@ The result is an `allocatable` length `character` scalar with up to `128` cached ```fortran {!example/strings/example_to_string.f90!} ``` + + +### `to_c_string` + +#### Description + +Convert a Fortran character string to a C character array. +This function converts a Fortran string into a C-style string, ensuring proper null-termination for use in C functions or libraries. + +#### Syntax + +`cstr = ` [[stdlib_strings(module):to_c_string(function)]] ` (value)` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `value`: Shall be a `character(len=*)` string. + This is an `intent(in)` argument. + The Fortran string that will be converted to a C character array. + +#### Result value + +The result is a `character(kind=c_char)` array with a dimension of `len(value) + 1` to accommodate the null terminator. From 5ee6bbbea907f9e850d2230d48d914aac6e9dcbc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 08:28:47 +0100 Subject: [PATCH 02/14] add `join`, `to_c_string` --- src/stdlib_strings.fypp | 95 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 93 insertions(+), 2 deletions(-) diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index a70bb38d2..d03aee4e7 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -5,16 +5,18 @@ !> The specification of this module is available [here](../page/specs/stdlib_strings.html). module stdlib_strings use stdlib_ascii, only: whitespace - use stdlib_string_type, only: string_type, char, verify, repeat, len + use stdlib_string_type, only: string_type, char, verify, repeat, len, len_trim, move use stdlib_optval, only: optval use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool + use iso_c_binding, only: c_char, c_null_char implicit none private public :: to_string + public :: to_c_string public :: strip, chomp public :: starts_with, ends_with - public :: slice, find, replace_all, padl, padr, count, zfill + public :: slice, find, replace_all, padl, padr, count, zfill, join !> Version: experimental !> @@ -164,6 +166,17 @@ module stdlib_strings module procedure :: zfill_char end interface zfill + !> Version: experimental + !> + !> Joins an array of strings into a single string. + !> The chunks are separated with a space, or an optional user-defined separator. + !> [Specifications](../page/specs/stdlib_strings.html#join) + interface join + module procedure :: join_string + module procedure :: join_char + end interface join + + contains @@ -943,5 +956,83 @@ contains end function zfill_char + !> Convert a Fortran character string to a C character array + !> + !> Version: experimental + pure function to_c_string(value) result(cstr) + character(len=*), intent(in) :: value + character(kind=c_char) :: cstr(len(value)+1) + integer :: i + do concurrent (i=1:len(value)) + cstr(i) = value(i:i) + end do + cstr(len(value)+1) = c_null_char + end function to_c_string + + !> Joins a list of strings with a separator (default: space). + !> Returns a new string + pure function join_string(strings, separator) result(cmd) + type(string_type), intent(in) :: strings(:) + character(len=*), intent(in), optional :: separator + type(string_type) :: cmd + integer :: ltot, i, lt, pos + character(len=:), allocatable :: sep,cmd_char + ! Determine separator: use user-provided separator or default space + if (present(separator)) then + sep = separator + else + sep = ' ' + end if + ! Calculate the total length required, including separators + ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep) + allocate(character(len=ltot) :: cmd_char) + + ! Concatenate strings with separator + pos = 0 + do i = 1, size(strings) + lt = len_trim(strings(i)) + cmd_char(pos+1:pos+lt) = char(strings(i),1,lt) + pos = pos + lt + if (i < size(strings)) then + cmd_char(pos+1:pos+len(sep)) = sep + pos = pos + len(sep) + end if + end do + + call move(from=cmd_char,to=cmd) + + end function join_string + + !> Joins a list of strings with a separator (default: space). + !> Returns a new string + pure function join_char(strings, separator) result(cmd) + character(*), intent(in) :: strings(:) + character(len=*), intent(in), optional :: separator + character(len=:), allocatable :: cmd + integer :: ltot, i, lt, pos + character(len=:), allocatable :: sep + ! Determine separator: use user-provided separator or default space + if (present(separator)) then + sep = separator + else + sep = ' ' + end if + ! Calculate the total length required, including separators + ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep) + allocate(character(len=ltot) :: cmd) + + cmd = repeat(' ',ltot) + ! Concatenate strings with separator + pos = 0 + do i = 1, size(strings) + lt = len_trim(strings(i)) + cmd(pos+1:pos+lt) = strings(i)(1:lt) + pos = pos + lt + if (i < size(strings)) then + cmd(pos+1:pos+len(sep)) = sep + pos = pos + len(sep) + end if + end do + end function join_char end module stdlib_strings From 311d9185cfacf4f65bcd84dd27d0206e533d21d7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 08:38:17 +0100 Subject: [PATCH 03/14] add `type(string_type)` version --- src/stdlib_kinds.fypp | 4 ++-- src/stdlib_strings.fypp | 38 +++++++++++++++++++++++++++++++------- 2 files changed, 33 insertions(+), 9 deletions(-) diff --git a/src/stdlib_kinds.fypp b/src/stdlib_kinds.fypp index f6b7726c1..ed578e846 100644 --- a/src/stdlib_kinds.fypp +++ b/src/stdlib_kinds.fypp @@ -4,10 +4,10 @@ !> The specification of this module is available [here](../page/specs/stdlib_kinds.html). module stdlib_kinds use iso_fortran_env, only: int8, int16, int32, int64 - use iso_c_binding, only: c_bool + use iso_c_binding, only: c_bool, c_char implicit none private - public :: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool + public :: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool, c_char !> Single precision real numbers integer, parameter :: sp = selected_real_kind(6) diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index d03aee4e7..0603b74e1 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -7,8 +7,8 @@ module stdlib_strings use stdlib_ascii, only: whitespace use stdlib_string_type, only: string_type, char, verify, repeat, len, len_trim, move use stdlib_optval, only: optval - use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool - use iso_c_binding, only: c_char, c_null_char + use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool, c_char + use iso_c_binding, only: c_null_char implicit none private @@ -45,6 +45,15 @@ module stdlib_strings #:endfor end interface to_string + !> Version: experimental + !> + !> Format or transfer other types as a string. + !> ([Specification](../page/specs/stdlib_strings.html#to_c_string)) + interface to_c_string + module procedure to_c_string_from_char + module procedure to_c_string_from_string + end interface to_c_string + !> Remove leading and trailing whitespace characters. !> !> Version: experimental @@ -959,15 +968,30 @@ contains !> Convert a Fortran character string to a C character array !> !> Version: experimental - pure function to_c_string(value) result(cstr) + pure function to_c_string_from_char(value) result(cstr) character(len=*), intent(in) :: value character(kind=c_char) :: cstr(len(value)+1) - integer :: i - do concurrent (i=1:len(value)) + integer :: i,lv + lv = len(value) + do concurrent (i=1:lv) cstr(i) = value(i:i) end do - cstr(len(value)+1) = c_null_char - end function to_c_string + cstr(lv+1) = c_null_char + end function to_c_string_from_char + + !> Convert a Fortran string type to a C character array + !> + !> Version: experimental + pure function to_c_string_from_string(value) result(cstr) + type(string_type), intent(in) :: value + character(kind=c_char) :: cstr(len(value)+1) + integer :: i,lv + lv = len(value) + do concurrent (i=1:lv) + cstr(i) = char(value,pos=i) + end do + cstr(lv+1) = c_null_char + end function to_c_string_from_string !> Joins a list of strings with a separator (default: space). !> Returns a new string From f958b7406bcc911ea337bef2745c38cf149a534c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 08:42:27 +0100 Subject: [PATCH 04/14] add example --- doc/specs/stdlib_strings.md | 7 +++---- example/strings/CMakeLists.txt | 3 ++- example/strings/example_to_c_string.f90 | 22 ++++++++++++++++++++++ 3 files changed, 27 insertions(+), 5 deletions(-) create mode 100644 example/strings/example_to_c_string.f90 diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 0c61907ee..7c0faf645 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -547,8 +547,8 @@ The result is an `allocatable` length `character` scalar with up to `128` cached #### Description -Convert a Fortran character string to a C character array. -This function converts a Fortran string into a C-style string, ensuring proper null-termination for use in C functions or libraries. +Convert a Fortran `character` string or a `type(string_type)` variable to a C character array. +This function converts a Fortran string into a C-style array of characters, ensuring proper null-termination for use in C functions or libraries. #### Syntax @@ -564,8 +564,7 @@ Pure function. #### Argument -- `value`: Shall be a `character(len=*)` string. - This is an `intent(in)` argument. +- `value`: Shall be a `character(len=*)` string or a `type(string_type)` variable. It is an `intent(in)` argument. The Fortran string that will be converted to a C character array. #### Result value diff --git a/example/strings/CMakeLists.txt b/example/strings/CMakeLists.txt index cbaf4f0f3..21f92627c 100644 --- a/example/strings/CMakeLists.txt +++ b/example/strings/CMakeLists.txt @@ -9,6 +9,7 @@ ADD_EXAMPLE(slice) ADD_EXAMPLE(starts_with) ADD_EXAMPLE(strip) ADD_EXAMPLE(to_string) +ADD_EXAMPLE(to_c_string) ADD_EXAMPLE(zfill) ADD_EXAMPLE(string_to_number) -ADD_EXAMPLE(stream_of_strings_to_numbers) \ No newline at end of file +ADD_EXAMPLE(stream_of_strings_to_numbers) diff --git a/example/strings/example_to_c_string.f90 b/example/strings/example_to_c_string.f90 new file mode 100644 index 000000000..5cd2ff4c5 --- /dev/null +++ b/example/strings/example_to_c_string.f90 @@ -0,0 +1,22 @@ +program example_to_c_string + use stdlib_strings, only: to_c_string + use stdlib_string_type, only: string_type + use stdlib_kinds, only: c_char + implicit none + + character(kind=c_char), allocatable :: cstr(:),cstr2(:) + character(*), parameter :: hello = "Hello, World!" + + ! Convert character array + cstr = to_c_string(hello) + + ! Convert string type + cstr2 = to_c_string(string_type(hello)) + + if (size(cstr)==size(cstr2) .and. all(cstr==cstr2)) then + stop 0 + else + error stop 'String conversion error' + end if + +end program example_to_c_string From f16afd27f9b6bdc1e6573eb5c0acaf0797e38ed2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 08:52:18 +0100 Subject: [PATCH 05/14] test: to_c_string --- test/string/test_string_to_string.f90 | 48 +++++++++++++++++++++++++-- 1 file changed, 46 insertions(+), 2 deletions(-) diff --git a/test/string/test_string_to_string.f90 b/test/string/test_string_to_string.f90 index 5f7be6886..fa571c658 100644 --- a/test/string/test_string_to_string.f90 +++ b/test/string/test_string_to_string.f90 @@ -1,7 +1,7 @@ ! SPDX-Identifier: MIT module test_string_to_string - use stdlib_strings, only: to_string, starts_with + use stdlib_strings, only: to_string, to_c_string, starts_with use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_optval, only: optval implicit none @@ -22,7 +22,8 @@ subroutine collect_string_to_string(testsuite) new_unittest("to_string-limit-i1", test_string_i1), & new_unittest("to_string-limit-i2", test_string_i2), & new_unittest("to_string-limit-i4", test_string_i4), & - new_unittest("to_string-limit-i8", test_string_i8) & + new_unittest("to_string-limit-i8", test_string_i8), & + new_unittest("to_c_string", test_to_c_string) & ] end subroutine collect_string_to_string @@ -149,6 +150,49 @@ subroutine test_to_string_logical(error) end subroutine test_to_string_logical + subroutine test_to_c_string(error) + use stdlib_kinds, only : c_char + use stdlib_string_type, only: string_type, len, char + use iso_c_binding, only: c_size_t + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Interface to C standard library + interface + integer(c_size_t) function c_strlen(cstr) bind(C, name="strlen") result(len) + import :: c_char, c_size_t + character(kind=c_char), intent(in) :: cstr(*) + end function c_strlen + end interface + + type(string_type) :: shello + character(kind=c_char), allocatable :: cstr(:) + character(*), parameter :: hello = "Hello, World!" + integer :: i + + ! Convert character array + cstr = to_c_string(hello) + call check(error, len(hello)==c_strlen(cstr), 'to_c_string_from_char: invalid C length') + if (allocated(error)) return + + do i=1,len(hello) + call check(error, hello(i:i)==cstr(i), 'to_c_string_from_char: character mismatch') + if (allocated(error)) return + end do + + ! Convert string type + shello = string_type(hello) + cstr = to_c_string(shello) + call check(error, len(shello)==c_strlen(cstr), 'to_c_string_from_string: invalid C length') + if (allocated(error)) return + + do i=1,len(shello) + call check(error, char(shello,pos=i)==cstr(i), 'to_c_string_from_string: character mismatch') + if (allocated(error)) return + end do + + end subroutine test_to_c_string subroutine test_string_i1(error) use stdlib_kinds, only : i1 => int8 From 0d27f920a097509561713c78555777a49d7b62ec Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 08:59:08 +0100 Subject: [PATCH 06/14] test `join` --- test/string/test_string_match.f90 | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/test/string/test_string_match.f90 b/test/string/test_string_match.f90 index a41821b10..be835ae7e 100644 --- a/test/string/test_string_match.f90 +++ b/test/string/test_string_match.f90 @@ -2,7 +2,7 @@ module test_string_match use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_ascii, only : reverse - use stdlib_strings, only : starts_with, ends_with + use stdlib_strings, only : starts_with, ends_with, join use stdlib_string_type, only : string_type implicit none @@ -16,7 +16,8 @@ subroutine collect_string_match(testsuite) testsuite = [ & new_unittest("starts_with", test_starts_with), & - new_unittest("ends_with", test_ends_with) & + new_unittest("ends_with", test_ends_with), & + new_unittest("join", test_join) & ] end subroutine collect_string_match @@ -77,6 +78,32 @@ subroutine check_ends_with(error, string, substring) call check(error, ends_with(string_type(string), string_type(substring)) .eqv. match, message) end subroutine check_ends_with + subroutine test_join(error) + type(error_type), allocatable, intent(out) :: error + character(len=5) :: test_strings(3) + + test_strings = [character(5) :: "one", "two", "three"] + call check_join(error, test_strings, " ", "one two three") + if (allocated(error)) return + call check_join(error, test_strings, ",", "one,two,three") + if (allocated(error)) return + call check_join(error, test_strings, "-", "one-two-three") + end subroutine test_join + + subroutine check_join(error, strings, separator, expected) + type(error_type), allocatable, intent(out) :: error + character(len=*), intent(in) :: strings(:) + character(len=*), intent(in) :: separator + character(len=*), intent(in) :: expected + character(len=:), allocatable :: joined + character(len=:), allocatable :: message + + joined = join(strings, separator) + message = "'join' error: Expected '" // expected // "' but got '" // joined // "'" + call check(error, joined == expected, message) + + end subroutine check_join + subroutine test_ends_with(error) type(error_type), allocatable, intent(out) :: error call check_ends_with(error, "pattern", "pat") From e902e5cc1f87477cacb648c7beadf7d18b692349 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 09:09:39 +0100 Subject: [PATCH 07/14] `join`: add example --- doc/specs/stdlib_strings.md | 14 +++++++------- example/strings/CMakeLists.txt | 1 + example/strings/example_join.f90 | 21 +++++++++++++++++++++ 3 files changed, 29 insertions(+), 7 deletions(-) create mode 100644 example/strings/example_join.f90 diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 7c0faf645..f930060f1 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -494,13 +494,7 @@ The result is of the same type as the elements of `strings` (`type(string_type)` #### Example ```fortran -! Example usage: -program test_join - type(string_type) :: result - type(string_type), dimension(3) :: words = [string_type('hello'), string_type('world'), string_type('fortran')] - result = join_string(words, ', ') ! Joins with comma and space - print *, result ! Output: "hello, world, fortran" -end program test_join +{!example/strings/example_join.f90!} ``` @@ -570,3 +564,9 @@ Pure function. #### Result value The result is a `character(kind=c_char)` array with a dimension of `len(value) + 1` to accommodate the null terminator. + +#### Example + +```fortran +{!example/strings/example_to_c_string.f90!} +``` diff --git a/example/strings/CMakeLists.txt b/example/strings/CMakeLists.txt index 21f92627c..c3158438c 100644 --- a/example/strings/CMakeLists.txt +++ b/example/strings/CMakeLists.txt @@ -2,6 +2,7 @@ ADD_EXAMPLE(chomp) ADD_EXAMPLE(count) ADD_EXAMPLE(ends_with) ADD_EXAMPLE(find) +ADD_EXAMPLE(join) ADD_EXAMPLE(padl) ADD_EXAMPLE(padr) ADD_EXAMPLE(replace_all) diff --git a/example/strings/example_join.f90 b/example/strings/example_join.f90 new file mode 100644 index 000000000..1b7947f83 --- /dev/null +++ b/example/strings/example_join.f90 @@ -0,0 +1,21 @@ +program example_join + use stdlib_strings, only: join + implicit none + + character(len=:), allocatable :: line + character(*), parameter :: words(3) = [character(7) :: "Hello", "World", "Fortran"] + + ! Default separator (space) + line = join(words) + print *, "'" // line // "'" !! 'Hello World Fortran' + + ! Custom separator + line = join(words, "_") + print *, "'" // line // "'" !! 'Hello_World_Fortran' + + ! Custom 2-character separator + line = join(words, ", ") + print *, "'" // line // "'" !! 'Hello, World, Fortran' + + stop 0 +end program example_join From 72e1c2353a89bd755ba11860309759c9c096e77c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 09:11:34 +0100 Subject: [PATCH 08/14] Update doc/specs/stdlib_strings.md --- doc/specs/stdlib_strings.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index f930060f1..f8819b9d9 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -484,7 +484,7 @@ Pure function - `strings`: Array of strings (either `type(string_type)` or `character(len=*)`). This argument is `intent(in)`. It is an array of strings that will be concatenated together. -- `separator`: Character scalar (optional). +- `separator`: `character(len=*)` scalar (optional). This argument is `intent(in)`. It specifies the separator to be used between the strings. If not provided, the default separator (a space) is used. #### Result value From 23e535bc8abea89d2b193961af5030d8a1ec7ddf Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 09:49:05 +0100 Subject: [PATCH 09/14] `to_c_string` -> `to_c_char`: rename --- doc/specs/stdlib_strings.md | 6 +++--- example/strings/CMakeLists.txt | 2 +- ..._to_c_string.f90 => example_to_c_char.f90} | 10 +++++----- src/stdlib_strings.fypp | 20 +++++++++---------- test/string/test_string_to_string.f90 | 20 +++++++++---------- 5 files changed, 29 insertions(+), 29 deletions(-) rename example/strings/{example_to_c_string.f90 => example_to_c_char.f90} (70%) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index f930060f1..877d995b3 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -537,7 +537,7 @@ The result is an `allocatable` length `character` scalar with up to `128` cached ``` -### `to_c_string` +### `to_c_char` #### Description @@ -546,7 +546,7 @@ This function converts a Fortran string into a C-style array of characters, ensu #### Syntax -`cstr = ` [[stdlib_strings(module):to_c_string(function)]] ` (value)` +`cstr = ` [[stdlib_strings(module):to_c_char(function)]] ` (value)` #### Status @@ -568,5 +568,5 @@ The result is a `character(kind=c_char)` array with a dimension of `len(value) + #### Example ```fortran -{!example/strings/example_to_c_string.f90!} +{!example/strings/example_to_c_char.f90!} ``` diff --git a/example/strings/CMakeLists.txt b/example/strings/CMakeLists.txt index c3158438c..cdf4d778c 100644 --- a/example/strings/CMakeLists.txt +++ b/example/strings/CMakeLists.txt @@ -10,7 +10,7 @@ ADD_EXAMPLE(slice) ADD_EXAMPLE(starts_with) ADD_EXAMPLE(strip) ADD_EXAMPLE(to_string) -ADD_EXAMPLE(to_c_string) +ADD_EXAMPLE(to_c_char) ADD_EXAMPLE(zfill) ADD_EXAMPLE(string_to_number) ADD_EXAMPLE(stream_of_strings_to_numbers) diff --git a/example/strings/example_to_c_string.f90 b/example/strings/example_to_c_char.f90 similarity index 70% rename from example/strings/example_to_c_string.f90 rename to example/strings/example_to_c_char.f90 index 5cd2ff4c5..b2b588933 100644 --- a/example/strings/example_to_c_string.f90 +++ b/example/strings/example_to_c_char.f90 @@ -1,5 +1,5 @@ -program example_to_c_string - use stdlib_strings, only: to_c_string +program example_to_c_char + use stdlib_strings, only: to_c_char use stdlib_string_type, only: string_type use stdlib_kinds, only: c_char implicit none @@ -8,10 +8,10 @@ program example_to_c_string character(*), parameter :: hello = "Hello, World!" ! Convert character array - cstr = to_c_string(hello) + cstr = to_c_char(hello) ! Convert string type - cstr2 = to_c_string(string_type(hello)) + cstr2 = to_c_char(string_type(hello)) if (size(cstr)==size(cstr2) .and. all(cstr==cstr2)) then stop 0 @@ -19,4 +19,4 @@ program example_to_c_string error stop 'String conversion error' end if -end program example_to_c_string +end program example_to_c_char diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index 0603b74e1..86bcb5c7d 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -13,7 +13,7 @@ module stdlib_strings private public :: to_string - public :: to_c_string + public :: to_c_char public :: strip, chomp public :: starts_with, ends_with public :: slice, find, replace_all, padl, padr, count, zfill, join @@ -48,11 +48,11 @@ module stdlib_strings !> Version: experimental !> !> Format or transfer other types as a string. - !> ([Specification](../page/specs/stdlib_strings.html#to_c_string)) - interface to_c_string - module procedure to_c_string_from_char - module procedure to_c_string_from_string - end interface to_c_string + !> ([Specification](../page/specs/stdlib_strings.html#to_c_char)) + interface to_c_char + module procedure to_c_char_from_char + module procedure to_c_char_from_string + end interface to_c_char !> Remove leading and trailing whitespace characters. !> @@ -968,7 +968,7 @@ contains !> Convert a Fortran character string to a C character array !> !> Version: experimental - pure function to_c_string_from_char(value) result(cstr) + pure function to_c_char_from_char(value) result(cstr) character(len=*), intent(in) :: value character(kind=c_char) :: cstr(len(value)+1) integer :: i,lv @@ -977,12 +977,12 @@ contains cstr(i) = value(i:i) end do cstr(lv+1) = c_null_char - end function to_c_string_from_char + end function to_c_char_from_char !> Convert a Fortran string type to a C character array !> !> Version: experimental - pure function to_c_string_from_string(value) result(cstr) + pure function to_c_char_from_string(value) result(cstr) type(string_type), intent(in) :: value character(kind=c_char) :: cstr(len(value)+1) integer :: i,lv @@ -991,7 +991,7 @@ contains cstr(i) = char(value,pos=i) end do cstr(lv+1) = c_null_char - end function to_c_string_from_string + end function to_c_char_from_string !> Joins a list of strings with a separator (default: space). !> Returns a new string diff --git a/test/string/test_string_to_string.f90 b/test/string/test_string_to_string.f90 index fa571c658..6465c7003 100644 --- a/test/string/test_string_to_string.f90 +++ b/test/string/test_string_to_string.f90 @@ -1,7 +1,7 @@ ! SPDX-Identifier: MIT module test_string_to_string - use stdlib_strings, only: to_string, to_c_string, starts_with + use stdlib_strings, only: to_string, to_c_char, starts_with use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_optval, only: optval implicit none @@ -23,7 +23,7 @@ subroutine collect_string_to_string(testsuite) new_unittest("to_string-limit-i2", test_string_i2), & new_unittest("to_string-limit-i4", test_string_i4), & new_unittest("to_string-limit-i8", test_string_i8), & - new_unittest("to_c_string", test_to_c_string) & + new_unittest("to_c_char", test_to_c_char) & ] end subroutine collect_string_to_string @@ -150,7 +150,7 @@ subroutine test_to_string_logical(error) end subroutine test_to_string_logical - subroutine test_to_c_string(error) + subroutine test_to_c_char(error) use stdlib_kinds, only : c_char use stdlib_string_type, only: string_type, len, char use iso_c_binding, only: c_size_t @@ -172,27 +172,27 @@ end function c_strlen integer :: i ! Convert character array - cstr = to_c_string(hello) - call check(error, len(hello)==c_strlen(cstr), 'to_c_string_from_char: invalid C length') + cstr = to_c_char(hello) + call check(error, len(hello)==c_strlen(cstr), 'to_c_char_from_char: invalid C length') if (allocated(error)) return do i=1,len(hello) - call check(error, hello(i:i)==cstr(i), 'to_c_string_from_char: character mismatch') + call check(error, hello(i:i)==cstr(i), 'to_c_char_from_char: character mismatch') if (allocated(error)) return end do ! Convert string type shello = string_type(hello) - cstr = to_c_string(shello) - call check(error, len(shello)==c_strlen(cstr), 'to_c_string_from_string: invalid C length') + cstr = to_c_char(shello) + call check(error, len(shello)==c_strlen(cstr), 'to_c_char_from_string: invalid C length') if (allocated(error)) return do i=1,len(shello) - call check(error, char(shello,pos=i)==cstr(i), 'to_c_string_from_string: character mismatch') + call check(error, char(shello,pos=i)==cstr(i), 'to_c_char_from_string: character mismatch') if (allocated(error)) return end do - end subroutine test_to_c_string + end subroutine test_to_c_char subroutine test_string_i1(error) use stdlib_kinds, only : i1 => int8 From 0f2165c7e2401b904d3c443b075dffad508ce9f2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 09:51:59 +0100 Subject: [PATCH 10/14] Update doc/specs/stdlib_strings.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_strings.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 05c839067..41767edaf 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -559,7 +559,7 @@ Pure function. #### Argument - `value`: Shall be a `character(len=*)` string or a `type(string_type)` variable. It is an `intent(in)` argument. - The Fortran string that will be converted to a C character array. + This Fortran variable will be converted to a C character array. #### Result value From 89df63a8d2b9e57543dff790e64a70633b5b5f10 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 09:52:47 +0100 Subject: [PATCH 11/14] Update example_to_c_char.f90 --- example/strings/example_to_c_char.f90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/example/strings/example_to_c_char.f90 b/example/strings/example_to_c_char.f90 index b2b588933..e15190446 100644 --- a/example/strings/example_to_c_char.f90 +++ b/example/strings/example_to_c_char.f90 @@ -13,9 +13,7 @@ program example_to_c_char ! Convert string type cstr2 = to_c_char(string_type(hello)) - if (size(cstr)==size(cstr2) .and. all(cstr==cstr2)) then - stop 0 - else + if (size(cstr)/=size(cstr2) .or. .not.all(cstr==cstr2)) then error stop 'String conversion error' end if From f2699969ee60a516e93604d7528888bee6cc7aba Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 09:53:52 +0100 Subject: [PATCH 12/14] Update example/strings/example_join.f90 Co-authored-by: Jeremie Vandenplas --- example/strings/example_join.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/example/strings/example_join.f90 b/example/strings/example_join.f90 index 1b7947f83..8d60b720d 100644 --- a/example/strings/example_join.f90 +++ b/example/strings/example_join.f90 @@ -17,5 +17,4 @@ program example_join line = join(words, ", ") print *, "'" // line // "'" !! 'Hello, World, Fortran' - stop 0 end program example_join From 1351a61d56565a5338e062bc289fe5348ee772ed Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Feb 2025 14:12:50 +0100 Subject: [PATCH 13/14] change result name to `joined` --- src/stdlib_strings.fypp | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index 86bcb5c7d..d3e268e54 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -995,12 +995,11 @@ contains !> Joins a list of strings with a separator (default: space). !> Returns a new string - pure function join_string(strings, separator) result(cmd) + pure type(string_type) function join_string(strings, separator) type(string_type), intent(in) :: strings(:) character(len=*), intent(in), optional :: separator - type(string_type) :: cmd integer :: ltot, i, lt, pos - character(len=:), allocatable :: sep,cmd_char + character(len=:), allocatable :: sep,joined ! Determine separator: use user-provided separator or default space if (present(separator)) then sep = separator @@ -1009,30 +1008,30 @@ contains end if ! Calculate the total length required, including separators ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep) - allocate(character(len=ltot) :: cmd_char) + allocate(character(len=ltot) :: joined) ! Concatenate strings with separator pos = 0 do i = 1, size(strings) lt = len_trim(strings(i)) - cmd_char(pos+1:pos+lt) = char(strings(i),1,lt) + joined(pos+1:pos+lt) = char(strings(i),1,lt) pos = pos + lt if (i < size(strings)) then - cmd_char(pos+1:pos+len(sep)) = sep + joined(pos+1:pos+len(sep)) = sep pos = pos + len(sep) end if end do - call move(from=cmd_char,to=cmd) + call move(from=joined,to=join_string) end function join_string !> Joins a list of strings with a separator (default: space). !> Returns a new string - pure function join_char(strings, separator) result(cmd) + pure function join_char(strings, separator) result(joined) character(*), intent(in) :: strings(:) character(len=*), intent(in), optional :: separator - character(len=:), allocatable :: cmd + character(len=:), allocatable :: joined integer :: ltot, i, lt, pos character(len=:), allocatable :: sep ! Determine separator: use user-provided separator or default space @@ -1043,17 +1042,17 @@ contains end if ! Calculate the total length required, including separators ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep) - allocate(character(len=ltot) :: cmd) + allocate(character(len=ltot) :: joined) - cmd = repeat(' ',ltot) + joined = repeat(' ',ltot) ! Concatenate strings with separator pos = 0 do i = 1, size(strings) lt = len_trim(strings(i)) - cmd(pos+1:pos+lt) = strings(i)(1:lt) + joined(pos+1:pos+lt) = strings(i)(1:lt) pos = pos + lt if (i < size(strings)) then - cmd(pos+1:pos+len(sep)) = sep + joined(pos+1:pos+len(sep)) = sep pos = pos + len(sep) end if end do From 1f24d540e10727e5e9210cc5bd118f9b7ffd7794 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 14 Feb 2025 00:25:14 -0600 Subject: [PATCH 14/14] Update stdlib_strings.md Co-authored-by: jalvesz <102541118+jalvesz@users.noreply.github.com> --- doc/specs/stdlib_strings.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 41767edaf..970800d4c 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -470,7 +470,7 @@ inserting a separator between each string (default: space). A user-defined separ #### Syntax -`cmd = ` [[stdlib_strings(module):join(interface)]] ` (strings, separator)` +`joined = ` [[stdlib_strings(module):join(interface)]] ` (strings, separator)` #### Status