diff --git a/doc/specs/stdlib_ascii.md b/doc/specs/stdlib_ascii.md index d80ae62ea..518a9eb7e 100644 --- a/doc/specs/stdlib_ascii.md +++ b/doc/specs/stdlib_ascii.md @@ -212,42 +212,4 @@ program demo_reverse implicit none print'(a)', reverse("Hello, World!") ! returns "!dlroW ,olleH" end program demo_reverse -``` - -### `to_string` - -#### Status - -Experimental - -#### Description - -Create a character string representing the value of the provided variable. - -#### Syntax - -`res = [[stdlib_ascii(module):to_string(interface)]] (string)` - -#### Class - -Pure function. - -#### Argument - -`val`: shall be an intrinsic integer or logical type. It is an `intent(in)` argument. - -#### Result value - -The result is an intrinsic character type. - -#### Example - -```fortran -program demo_string_value - use stdlib_ascii, only : to_string - implicit none - print'(a)', to_string(-3) ! returns "-3" - print'(a)', to_string(.true.) ! returns "T" - print'(a)', to_string(42) ! returns "42" -end program demo_string_value -``` +``` \ No newline at end of file diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 3dcc8343a..f16995b48 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -538,3 +538,72 @@ program demo_count end program demo_count ``` + + +### `to_string` + +#### Description + +Format or transfer a `integer/real/complex/logical` scalar as a string. +Input a wrong `format` that cause the internal-IO to fail, the result value is a string of `[*]`. + +#### Syntax + +`string = [[stdlib_strings(module):to_string(interface)]] (value [, format])` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `value`: Shall be an `integer/real/complex/logical` scalar. + This is an `intent(in)` argument. +- `format`: Shall be a `character(len=*)` scalar like `'(F6.2)'` or just `'F6.2'`. + This is an `intent(in)` and `optional` argument. + Contains the edit descriptor to format `value` into a string, for example `'(F6.2)'` or `'(f6.2)'`. + `to_string` will automatically enclose `format` in a set of parentheses, so passing `F6.2` or `f6.2` as `format` is possible as well. + +#### Result value + +The result is an `allocatable` length `character` scalar with up to `128` cached `character` length. + +#### Example + +```fortran +program demo_to_string + use stdlib_strings, only: to_string + + !> Example for `complex` type + print *, to_string((1, 1)) !! "(1.00000000,1.00000000)" + print *, to_string((1, 1), '(F6.2)') !! "( 1.00, 1.00)" + print *, to_string((1000, 1), '(ES0.2)'), to_string((1000, 1), '(SP,F6.3)') + !! "(1.00E+3,1.00)""(******,+1.000)" + !! Too narrow formatter for real number + !! Normal demonstration(`******` from Fortran Standard) + + !> Example for `integer` type + print *, to_string(-3) !! "-3" + print *, to_string(42, '(I4)') !! " 42" + print *, to_string(1, '(I0.4)'), to_string(2, '(B4)') !! "0001"" 10" + + !> Example for `real` type + print *, to_string(1.) !! "1.00000000" + print *, to_string(1., '(F6.2)') !! " 1.00" + print *, to_string(1., 'F6.2') !! " 1.00" + print *, to_string(1., '(SP,ES9.2)'), to_string(1, '(F7.3)') !! "+1.00E+00""[*]" + !! 1 wrong demonstration (`[*]` from `to_string`) + + !> Example for `logical` type + print *, to_string(.true.) !! "T" + print *, to_string(.true., '(L2)') !! " T" + print *, to_string(.true., 'L2') !! " T" + print *, to_string(.false., '(I5)') !! "[*]" + !! 1 wrong demonstrations(`[*]` from `to_string`) + +end program demo_to_string +``` \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c4c6cf858..80804891c 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -34,6 +34,9 @@ set(fppFiles stdlib_math_logspace.fypp stdlib_math_arange.fypp stdlib_string_type.fypp + stdlib_string_type_constructor.fypp + stdlib_strings_to_string.fypp + stdlib_strings.fypp ) @@ -52,7 +55,6 @@ set(SRC stdlib_error.f90 stdlib_kinds.f90 stdlib_logger.f90 - stdlib_strings.f90 stdlib_system.F90 stdlib_specialfunctions.f90 stdlib_specialfunctions_legendre.f90 diff --git a/src/Makefile.manual b/src/Makefile.manual index 9e78df5d8..5c1d2ba8d 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -1,4 +1,4 @@ -SRCFYPP =\ +SRCFYPP = \ stdlib_ascii.fypp \ stdlib_bitsets_64.fypp \ stdlib_bitsets_large.fypp \ @@ -27,10 +27,13 @@ SRCFYPP =\ stdlib_stats_moment_scalar.fypp \ stdlib_stats_var.fypp \ stdlib_math.fypp \ - stdlib_math_linspace.fypp \ - stdlib_math_logspace.fypp \ + stdlib_math_linspace.fypp \ + stdlib_math_logspace.fypp \ stdlib_stats_distribution_PRNG.fypp \ - stdlib_string_type.fypp + stdlib_string_type.fypp \ + stdlib_string_type_constructor.fypp \ + stdlib_strings.fypp \ + stdlib_strings_to_string.fypp SRC = f18estop.f90 \ stdlib_error.f90 \ @@ -40,7 +43,6 @@ SRC = f18estop.f90 \ stdlib_kinds.f90 \ stdlib_logger.f90 \ stdlib_quadrature_gauss.f90 \ - stdlib_strings.f90 \ $(SRCGEN) LIB = libstdlib.a @@ -77,85 +79,89 @@ stdlib_error.o: stdlib_optval.o stdlib_specialfunctions.o: stdlib_kinds.o stdlib_specialfunctions_legendre.o: stdlib_kinds.o stdlib_specialfunctions.o stdlib_io.o: \ - stdlib_ascii.o \ - stdlib_error.o \ - stdlib_optval.o \ - stdlib_kinds.o + stdlib_ascii.o \ + stdlib_error.o \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_ascii.o stdlib_linalg.o: \ - stdlib_kinds.o + stdlib_kinds.o stdlib_linalg_diag.o: \ - stdlib_linalg.o \ - stdlib_kinds.o + stdlib_linalg.o \ + stdlib_kinds.o stdlib_logger.o: stdlib_ascii.o stdlib_optval.o stdlib_optval.o: stdlib_kinds.o stdlib_quadrature.o: stdlib_kinds.o - stdlib_quadrature_gauss.o: stdlib_kinds.o stdlib_quadrature.o - stdlib_quadrature_simps.o: \ - stdlib_quadrature.o \ - stdlib_error.o \ - stdlib_kinds.o + stdlib_quadrature.o \ + stdlib_error.o \ + stdlib_kinds.o stdlib_quadrature_trapz.o: \ - stdlib_quadrature.o \ - stdlib_error.o \ - stdlib_kinds.o + stdlib_quadrature.o \ + stdlib_error.o \ + stdlib_kinds.o stdlib_sorting.o: \ - stdlib_kinds.o \ - stdlib_string_type.o + stdlib_kinds.o \ + stdlib_string_type.o stdlib_sorting_ord_sort.o: \ - stdlib_sorting.o + stdlib_sorting.o stdlib_sorting_sort.o: \ - stdlib_sorting.o + stdlib_sorting.o stdlib_sorting_sort_index.o: \ - stdlib_sorting.o + stdlib_sorting.o stdlib_stats.o: \ - stdlib_kinds.o + stdlib_kinds.o stdlib_stats_corr.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o stdlib_stats_cov.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o stdlib_stats_mean.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o stdlib_stats_median.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_sorting.o \ - stdlib_stats.o + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_sorting.o \ + stdlib_stats.o stdlib_stats_moment.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o stdlib_stats_moment_all.o: \ - stdlib_stats_moment.o + stdlib_stats_moment.o stdlib_stats_moment_mask.o: \ - stdlib_stats_moment.o + stdlib_stats_moment.o stdlib_stats_moment_scalar.o: \ - stdlib_stats_moment.o + stdlib_stats_moment.o stdlib_stats_var.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o stdlib_stats_distribution_PRNG.o: \ - stdlib_kinds.o \ - stdlib_error.o + stdlib_kinds.o \ + stdlib_error.o stdlib_string_type.o: stdlib_ascii.o \ stdlib_kinds.o +stdlib_string_type_constructor.o: stdlib_string_type.o \ + stdlib_strings_to_string.o \ + stdlib_strings.o stdlib_strings.o: stdlib_ascii.o \ stdlib_string_type.o \ - stdlib_optval.o + stdlib_optval.o \ + stdlib_kinds.o +stdlib_strings_to_string.o: stdlib_strings.o stdlib_math.o: stdlib_kinds.o \ stdlib_optval.o stdlib_math_linspace.o: \ - stdlib_math.o + stdlib_math.o stdlib_math_logspace.o: \ - stdlib_math_linspace.o + stdlib_math_linspace.o stdlib_math_arange.o: \ stdlib_math.o stdlib_linalg_outer_product.o: stdlib_linalg.o diff --git a/src/stdlib_ascii.fypp b/src/stdlib_ascii.fypp index 6415fa604..8dc47388a 100644 --- a/src/stdlib_ascii.fypp +++ b/src/stdlib_ascii.fypp @@ -20,19 +20,6 @@ module stdlib_ascii ! Character conversion functions public :: to_lower, to_upper, to_title, to_sentence, reverse - public :: to_string - - !> Version: experimental - !> - !> Create a character string representing the value of the provided variable. - interface to_string - #:for kind in INT_KINDS - module procedure :: to_string_integer_${kind}$ - #:endfor - #:for kind in LOG_KINDS - module procedure :: to_string_logical_${kind}$ - #:endfor - end interface to_string ! All control characters in the ASCII table (see www.asciitable.com). character(len=1), public, parameter :: NUL = achar(int(z'00')) !! Null @@ -362,51 +349,4 @@ contains end function reverse - #:for kind in INT_KINDS - !> Represent an integer of kind ${kind}$ as character sequence - pure function to_string_integer_${kind}$(val) result(string) - integer, parameter :: ik = ${kind}$ - integer(ik), intent(in) :: val - character(len=:), allocatable :: string - integer, parameter :: buffer_len = range(val)+2 - character(len=buffer_len) :: buffer - integer :: pos - integer(ik) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - - if (val == 0_ik) then - string = numbers(0) - return - end if - - n = abs(val) - buffer = "" - - pos = buffer_len + 1 - do while (n > 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_ik)) - n = n/10_ik - end do - if (val < 0_ik) then - pos = pos - 1 - buffer(pos:pos) = '-' - end if - - string = buffer(pos:) - end function to_string_integer_${kind}$ - #:endfor - - #:for kind in LOG_KINDS - !> Represent an logical of kind ${kind}$ as character sequence - pure function to_string_logical_${kind}$(val) result(string) - integer, parameter :: ik = ${kind}$ - logical(ik), intent(in) :: val - character(len=1) :: string - - string = merge("T", "F", val) - end function to_string_logical_${kind}$ - #:endfor - end module stdlib_ascii diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index a802830b2..ee853f719 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -14,7 +14,7 @@ !> The specification of this module is available [here](../page/specs/stdlib_string_type.html). module stdlib_string_type use stdlib_ascii, only: to_lower_ => to_lower, to_upper_ => to_upper, & - & to_title_ => to_title, to_sentence_ => to_sentence, reverse_ => reverse, to_string + & to_title_ => to_title, to_sentence_ => to_sentence, reverse_ => reverse use stdlib_kinds, only : int8, int16, int32, int64, lk, c_bool implicit none private @@ -42,18 +42,6 @@ module stdlib_string_type character(len=:), allocatable :: raw end type string_type - !> Constructor for new string instances - interface string_type - module procedure :: new_string - #:for kind in INT_KINDS - module procedure :: new_string_from_integer_${kind}$ - #:endfor - #:for kind in LOG_KINDS - module procedure :: new_string_from_logical_${kind}$ - #:endfor - end interface string_type - - !> Returns the length of the character sequence represented by the string. !> !> This method is elemental and returns a default integer scalar value. @@ -61,6 +49,26 @@ module stdlib_string_type module procedure :: len_string end interface len + !> Constructor for new string instances + interface string_type + pure elemental module function new_string(string) result(new) + character(len=*), intent(in), optional :: string + type(string_type) :: new + end function new_string + #:for kind in INT_KINDS + pure elemental module function new_string_from_integer_${kind}$(val) result(new) + integer(${kind}$), intent(in) :: val + type(string_type) :: new + end function new_string_from_integer_${kind}$ + #:endfor + #:for kind in LOG_KINDS + pure elemental module function new_string_from_logical_${kind}$(val) result(new) + logical(${kind}$), intent(in) :: val + type(string_type) :: new + end function new_string_from_logical_${kind}$ + #:endfor + end interface string_type + !> Returns the length of the character sequence without trailing spaces !> represented by the string. !> @@ -356,35 +364,6 @@ module stdlib_string_type contains - - !> Constructor for new string instances from a scalar character value. - elemental function new_string(string) result(new) - character(len=*), intent(in), optional :: string - type(string_type) :: new - if (present(string)) then - new%raw = string - end if - end function new_string - - #:for kind in INT_KINDS - !> Constructor for new string instances from an integer of kind ${kind}$. - elemental function new_string_from_integer_${kind}$(val) result(new) - integer(${kind}$), intent(in) :: val - type(string_type) :: new - new%raw = to_string(val) - end function new_string_from_integer_${kind}$ - #:endfor - - #:for kind in LOG_KINDS - !> Constructor for new string instances from a logical of kind ${kind}$. - elemental function new_string_from_logical_${kind}$(val) result(new) - logical(${kind}$), intent(in) :: val - type(string_type) :: new - new%raw = to_string(val) - end function new_string_from_logical_${kind}$ - #:endfor - - !> Assign a character sequence to a string. elemental subroutine assign_string_char(lhs, rhs) type(string_type), intent(inout) :: lhs diff --git a/src/stdlib_string_type_constructor.fypp b/src/stdlib_string_type_constructor.fypp new file mode 100644 index 000000000..859eaf103 --- /dev/null +++ b/src/stdlib_string_type_constructor.fypp @@ -0,0 +1,35 @@ +#:include "common.fypp" +submodule(stdlib_string_type) stdlib_string_type_constructor + + use stdlib_strings, only: to_string + +contains + + !> Constructor for new string instances from a scalar character value. + elemental module function new_string(string) result(new) + character(len=*), intent(in), optional :: string + type(string_type) :: new + if (present(string)) then + new%raw = string + end if + end function new_string + + #:for kind in INT_KINDS + !> Constructor for new string instances from an integer of kind ${kind}$. + elemental module function new_string_from_integer_${kind}$(val) result(new) + integer(${kind}$), intent(in) :: val + type(string_type) :: new + new%raw = to_string(val) + end function new_string_from_integer_${kind}$ + #:endfor + + #:for kind in LOG_KINDS + !> Constructor for new string instances from a logical of kind ${kind}$. + elemental module function new_string_from_logical_${kind}$(val) result(new) + logical(${kind}$), intent(in) :: val + type(string_type) :: new + new%raw = to_string(val) + end function new_string_from_logical_${kind}$ + #:endfor + +end submodule stdlib_string_type_constructor \ No newline at end of file diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.fypp similarity index 95% rename from src/stdlib_strings.f90 rename to src/stdlib_strings.fypp index 095ac93b9..fdce00d01 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.fypp @@ -1,5 +1,5 @@ ! SPDX-Identifier: MIT - +#:include "common.fypp" !> This module implements basic string handling routines. !> !> The specification of this module is available [here](../page/specs/stdlib_strings.html). @@ -7,13 +7,41 @@ module stdlib_strings use stdlib_ascii, only: whitespace use stdlib_string_type, only: string_type, char, verify, repeat, len use stdlib_optval, only: optval + use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64, lk, c_bool implicit none private + public :: to_string public :: strip, chomp public :: starts_with, ends_with public :: slice, find, replace_all, padl, padr, count + !> Version: experimental + !> + !> Format or transfer other types as a string. + !> ([Specification](../page/specs/stdlib_strings.html#to_string)) + interface to_string + #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + #:set IL_KINDS_TYPES = INT_KINDS_TYPES + LOG_KINDS_TYPES + #:for k1, t1 in RC_KINDS_TYPES + pure module function to_string_${t1[0]}$_${k1}$(value, format) result(string) + ${t1}$, intent(in) :: value + character(len=*), intent(in), optional :: format + character(len=:), allocatable :: string + end function to_string_${t1[0]}$_${k1}$ + #:endfor + #:for k1, t1 in IL_KINDS_TYPES + pure module function to_string_1_${t1[0]}$_${k1}$(value) result(string) + ${t1}$, intent(in) :: value + character(len=#{if t1[0]=="l"}#1)#{else}#:), allocatable#{endif}# :: string + end function to_string_1_${t1[0]}$_${k1}$ + pure module function to_string_2_${t1[0]}$_${k1}$(value, format) result(string) + ${t1}$, intent(in) :: value + character(len=*), intent(in) :: format + character(len=:), allocatable :: string + end function to_string_2_${t1[0]}$_${k1}$ + #:endfor + end interface to_string !> Remove leading and trailing whitespace characters. !> diff --git a/src/stdlib_strings_to_string.fypp b/src/stdlib_strings_to_string.fypp new file mode 100644 index 000000000..c7d4d013d --- /dev/null +++ b/src/stdlib_strings_to_string.fypp @@ -0,0 +1,123 @@ +#:include "common.fypp" +submodule(stdlib_strings) stdlib_strings_to_string + + integer, parameter :: buffer_len = 128 + character(len=*), parameter :: err_sym = "[*]" + !!TODO: [*]? + +contains + + #:for k1, t1 in REAL_KINDS_TYPES + !> Format or transfer a ${t1}$ scalar as a string. + pure module function to_string_${t1[0]}$_${k1}$(value, format) result(string) + ${t1}$, intent(in) :: value + character(len=*), intent(in), optional :: format + character(len=:), allocatable :: string + + character(len=buffer_len) :: buffer + integer :: stat + + write(buffer, '(' // optval(format, "g0") // ')', iostat=stat) value + if (stat == 0) then + string = trim(buffer) + else + string = err_sym + end if + + end function to_string_${t1[0]}$_${k1}$ + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + !> Format or transfer a ${t1}$ scalar as a string. + pure module function to_string_${t1[0]}$_${k1}$(value, format) result(string) + ${t1}$, intent(in) :: value + character(len=*), intent(in), optional :: format + character(len=:), allocatable :: string + + string = '(' // to_string_r_${k1}$(value%re, format) // ',' // & + & to_string_r_${k1}$(value%im, format) // ')' + + end function to_string_${t1[0]}$_${k1}$ + #:endfor + + #:for k1, t1 in INT_KINDS_TYPES + !> Represent an integer of kind ${k1}$ as character sequence. + pure module function to_string_1_${t1[0]}$_${k1}$(value) result(string) + ${t1}$, intent(in) :: value + character(len=:), allocatable :: string + integer, parameter :: buffer_len = range(value)+2 + character(len=buffer_len) :: buffer + integer :: pos + ${t1}$ :: n + character(len=1), parameter :: numbers(0:9) = & + ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + + if (value == 0_${k1}$) then + string = numbers(0) + return + end if + + n = abs(value) + buffer = "" + + pos = buffer_len + 1 + do while (n > 0_${k1}$) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_${k1}$)) + n = n/10_${k1}$ + end do + if (value < 0_${k1}$) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function to_string_1_${t1[0]}$_${k1}$ + + pure module function to_string_2_${t1[0]}$_${k1}$(value, format) result(string) + ${t1}$, intent(in) :: value + character(len=*), intent(in) :: format + character(len=:), allocatable :: string + + character(len=buffer_len) :: buffer + integer :: stat + + write(buffer, "(" // format // ")", iostat=stat) value + if (stat == 0) then + string = trim(buffer) + else + string = err_sym + end if + + end function to_string_2_${t1[0]}$_${k1}$ + #:endfor + + #:for k1, t1 in LOG_KINDS_TYPES + !> Represent an logical of kind ${k1}$ as character sequence. + pure module function to_string_1_${t1[0]}$_${k1}$(value) result(string) + ${t1}$, intent(in) :: value + character(len=1) :: string + + string = merge("T", "F", value) + + end function to_string_1_${t1[0]}$_${k1}$ + + pure module function to_string_2_${t1[0]}$_${k1}$(value, format) result(string) + ${t1}$, intent(in) :: value + character(len=*), intent(in) :: format + character(len=:), allocatable :: string + + character(len=buffer_len) :: buffer + integer :: stat + + write(buffer, "(" // format // ")", iostat=stat) value + if (stat == 0) then + string = trim(buffer) + else + string = err_sym + end if + + end function to_string_2_${t1[0]}$_${k1}$ + #:endfor + +end submodule stdlib_strings_to_string diff --git a/src/tests/ascii/test_ascii.f90 b/src/tests/ascii/test_ascii.f90 index 9ea29d5f7..c93a1f6e6 100644 --- a/src/tests/ascii/test_ascii.f90 +++ b/src/tests/ascii/test_ascii.f90 @@ -6,8 +6,7 @@ program test_ascii whitespace, letters, is_alphanum, is_alpha, is_lower, is_upper, & is_digit, is_octal_digit, is_hex_digit, is_white, is_blank, & is_control, is_punctuation, is_graphical, is_printable, is_ascii, & - to_lower, to_upper, to_title, to_sentence, reverse, LF, TAB, NUL, DEL, & - to_string + to_lower, to_upper, to_title, to_sentence, reverse, LF, TAB, NUL, DEL use stdlib_kinds, only : int8, int16, int32, int64, lk, c_bool implicit none @@ -76,8 +75,6 @@ program test_ascii call test_to_sentence_string call test_reverse_string - call test_to_string - contains subroutine test_is_alphanum_short @@ -640,47 +637,4 @@ subroutine test_reverse_string call check(trim(adjustl(dlc)) == "desrever") end subroutine test_reverse_string - subroutine test_to_string - character(len=128) :: flc - - write(flc, '(g0)') 1026192 - call check(to_string(1026192) == trim(flc)) - - write(flc, '(g0)') -124784 - call check(to_string(-124784) == trim(flc)) - - write(flc, '(g0)') 1_int8 - call check(to_string(1_int8) == trim(flc)) - - write(flc, '(g0)') -3_int8 - call check(to_string(-3_int8) == trim(flc)) - - write(flc, '(g0)') 80_int16 - call check(to_string(80_int16) == trim(flc)) - - write(flc, '(g0)') 8924890_int32 - call check(to_string(8924890_int32) == trim(flc)) - - write(flc, '(g0)') -2378401_int32 - call check(to_string(-2378401_int32) == trim(flc)) - - write(flc, '(g0)') -921092378401_int64 - call check(to_string(-921092378401_int64) == trim(flc)) - - write(flc, '(g0)') 1272835771_int64 - call check(to_string(1272835771_int64) == trim(flc)) - - write(flc, '(g0)') .true. - call check(to_string(.true.) == trim(flc)) - - write(flc, '(g0)') .false. - call check(to_string(.false.) == trim(flc)) - - write(flc, '(g0)') .true._c_bool - call check(to_string(.true._c_bool) == trim(flc)) - - write(flc, '(g0)') .false._lk - call check(to_string(.false._lk) == trim(flc)) - end subroutine test_to_string - end program test_ascii diff --git a/src/tests/string/CMakeLists.txt b/src/tests/string/CMakeLists.txt index e0d1d9710..59ee5cf86 100644 --- a/src/tests/string/CMakeLists.txt +++ b/src/tests/string/CMakeLists.txt @@ -5,3 +5,4 @@ ADDTEST(string_match) ADDTEST(string_derivedtype_io) ADDTEST(string_functions) ADDTEST(string_strip_chomp) +ADDTEST(string_to_string) diff --git a/src/tests/string/Makefile.manual b/src/tests/string/Makefile.manual index 2e91044a1..8b93f625b 100644 --- a/src/tests/string/Makefile.manual +++ b/src/tests/string/Makefile.manual @@ -4,7 +4,8 @@ PROGS_SRC = test_string_assignment.f90 \ test_string_intrinsic.f90 \ test_string_match.f90 \ test_string_operator.f90 \ - test_string_strip_chomp.f90 + test_string_strip_chomp.f90 \ + test_string_to_string.f90 include ../Makefile.manual.test.mk diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index 4b5f78425..8885e985b 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -6,7 +6,7 @@ module test_string_functions to_lower, to_upper, to_title, to_sentence, reverse use stdlib_strings, only: slice, find, replace_all, padl, padr, count use stdlib_optval, only: optval - use stdlib_ascii, only : to_string + use stdlib_strings, only : to_string implicit none contains diff --git a/src/tests/string/test_string_to_string.f90 b/src/tests/string/test_string_to_string.f90 new file mode 100644 index 000000000..15bfb7531 --- /dev/null +++ b/src/tests/string/test_string_to_string.f90 @@ -0,0 +1,113 @@ +! SPDX-Identifier: MIT +module test_string_to_string + + use stdlib_strings, only: to_string, starts_with + use stdlib_error, only: check + use stdlib_optval, only: optval + implicit none + +contains + + subroutine check_formatter(actual, expected, description, partial) + character(len=*), intent(in) :: actual, expected, description + logical, intent(in), optional :: partial + logical :: stat + character(len=:), allocatable :: msg + + if (optval(partial, .false.)) then + stat = starts_with(actual, expected) + else + stat = actual == expected + end if + + if (.not. stat) then + msg = description // new_line("a") // & + & "Expected: '" // expected // "' but got '" // actual // "'" + else + print '(" - ", a, /, " Result: ''", a, "''")', description, actual + end if + + call check(stat, msg) + + end subroutine check_formatter + + subroutine test_to_string_complex + call check_formatter(to_string((1, 1)), "(1.0", & + & "Default formatter for complex number", partial=.true.) + call check_formatter(to_string((1, 1), '(F6.2)'), "( 1.00, 1.00)", & + & "Formatter for complex number") + call check_formatter(to_string((-1, -1), 'F6.2'), "( -1.00, -1.00)", & + & "Formatter for negative complex number") + call check_formatter(to_string((1, 1), 'SP,F6.2'), "( +1.00, +1.00)", & + & "Formatter with sign control descriptor for complex number") + call check_formatter(to_string((1, 1), 'F6.2') // to_string((2, 2), '(F7.3)'), & + & "( 1.00, 1.00)( 2.000, 2.000)", & + & "Multiple formatters for complex numbers") + + end subroutine test_to_string_complex + + subroutine test_to_string_integer + call check_formatter(to_string(100), "100", & + & "Default formatter for integer number") + call check_formatter(to_string(100, 'I6'), " 100", & + & "Formatter for integer number") + call check_formatter(to_string(100, 'I0.6'), "000100", & + & "Formatter with zero padding for integer number") + call check_formatter(to_string(100, 'I6') // to_string(1000, '(I7)'), & + & " 100 1000", "Multiple formatters for integers") + call check_formatter(to_string(34, 'B8'), " 100010", & + & "Binary formatter for integer number") + call check_formatter(to_string(34, 'O0.3'), "042", & + & "Octal formatter with zero padding for integer number") + call check_formatter(to_string(34, 'Z3'), " 22", & + & "Hexadecimal formatter for integer number") + + end subroutine test_to_string_integer + + subroutine test_to_string_real + call check_formatter(to_string(100.), "100.0", & + & "Default formatter for real number", partial=.true.) + call check_formatter(to_string(100., 'F6.2'), "100.00", & + & "Formatter for real number") + call check_formatter(to_string(289., 'E7.2'), ".29E+03", & + & "Exponential formatter with rounding for real number") + call check_formatter(to_string(128., 'ES8.2'), "1.28E+02", & + & "Exponential formatter for real number") + + ! Wrong demonstration + call check_formatter(to_string(-100., 'F6.2'), "*", & + & "Too narrow formatter for signed real number", partial=.true.) + call check_formatter(to_string(1000., 'F6.3'), "*", & + & "Too narrow formatter for real number", partial=.true.) + call check_formatter(to_string(1000., '7.3'), "[*]", & + & "Invalid formatter for real number", partial=.true.) + + end subroutine test_to_string_real + + subroutine test_to_string_logical + call check_formatter(to_string(.true.), "T", & + & "Default formatter for logcal value") + call check_formatter(to_string(.true., 'L2'), " T", & + & "Formatter for logical value") + call check_formatter(to_string(.false., 'L2') // to_string(.true., '(L5)'), & + & " F T", "Multiple formatters for logical values") + + ! Wrong demonstration + call check_formatter(to_string(.false., '1x'), "[*]", & + & "Invalid formatter for logical value", partial=.true.) + + end subroutine test_to_string_logical + + +end module test_string_to_string + +program tester + use test_string_to_string + implicit none + + call test_to_string_complex + call test_to_string_integer + call test_to_string_logical + call test_to_string_real + +end program tester