diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 5021aef15..ae348c222 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -283,7 +283,6 @@ Default value of `occurrence` is set to `1`. If `consider_overlapping` is not provided or is set to `.true.` the function counts two overlapping occurrences of substring as two different occurrences. If `occurrence`th occurrence is not found, function returns `0`. - #### Syntax `string = [[stdlib_strings(module):find(interface)]] (string, pattern [, occurrence, consider_overlapping])` @@ -336,10 +335,9 @@ end program demo_find Format or transfer a integer/real/complex/logical variable as a character sequence. - #### Syntax -`format_string = [[stdlib_strings(module):format_string(interface)]] (value [, format])` +`format_string = [[stdlib_strings(module):format_string(interface)]] (val [, fmt])` #### Status @@ -358,33 +356,38 @@ Pure function #### Result value -The result is a allocatable length Character scalar. +The result is an allocatable length Character scalar. #### Example ```fortran -program demo_strings_format_string +program demo_format_string use, non_intrinsic :: stdlib_strings, only: format_string implicit none + print *, 'format_string(complex) : ' print *, format_string((1, 1)) ! (1.00000000,1.00000000) print *, format_string((1, 1), '(F6.2)') ! ( 1.00, 1.00) print *, format_string((1000, 1), '(ES0.2)'), format_string((1000, 1), '(SP,F6.3)') ! (1.00E+3,1.00)(******,+1.000) !! Too narrow formatter for real number !! Normal demonstration(`******` from Fortran Standard) + print *, 'format_string(integer) : ' print *, format_string(1) ! 1 print *, format_string(1, '(I4)') ! 1 print *, format_string(1, '(I0.4)'), format_string(2, '(B4)') ! 0001 10 + print *, 'format_string(real) : ' print *, format_string(1.) ! 1.00000000 print *, format_string(1., '(F6.2)') ! 1.00 print *, format_string(1., '(SP,ES9.2)'), format_string(1, '(F7.3)') ! +1.00E+00* !! 1 wrong demonstration(`*` from `format_string`) + print *, 'format_string(logical) : ' print *, format_string(.true.) ! T print *, format_string(.true., '(L2)') ! T print *, format_string(.true., 'L2'), format_string(.false., '(I5)') ! ** !! 2 wrong demonstrations(`*` from `format_string`) -end program demo_strings_format_string + +end program demo_format_string ``` \ No newline at end of file diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index 6432d45df..893a8a224 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -18,17 +18,18 @@ module stdlib_strings public :: starts_with, ends_with public :: slice, find + !> Format other types as character sequence. + !> ([Specification](../page/specs/stdlib_strings.html#description)) + !> Version: experimental interface format_string - !! version: experimental - !! - !! Format other types as character sequence. - !! ([Specification](../page/specs/stdlib_strings.html#description)) #:for kind, type in KINDS_TYPES - pure module function format_string_${type[0]}$${kind}$(val, fmt) result(string) - character(len=:), allocatable :: string + !> Format ${type}$ variable as character sequence + pure module function format_string_${type[0]}$_${kind}$(val, fmt) result(string) ${type}$, intent(in) :: val character(len=*), intent(in), optional :: fmt - end function format_string_${type[0]}$${kind}$ + character(len=:), allocatable :: string + end function format_string_${type[0]}$_${kind}$ + #:endfor end interface format_string diff --git a/src/stdlib_strings_format_string.fypp b/src/stdlib_strings_format_string.fypp index 5486acfbe..702ad9fe5 100644 --- a/src/stdlib_strings_format_string.fypp +++ b/src/stdlib_strings_format_string.fypp @@ -7,9 +7,11 @@ submodule (stdlib_strings) stdlib_strings_format_string contains - #:for kind, type in RIL_KINDS_TYPES - module procedure format_string_${type[0]}$${kind}$ - !! Format ${type}$ variable as character sequence + + #:for kind, type in RIL_KINDS_TYPES + !> Format ${type}$ variable as character sequence + module procedure format_string_${type[0]}$_${kind}$ + character(len=buffer_len) :: buffer integer :: stat @@ -21,17 +23,19 @@ contains !!\TODO: *? end if - end procedure format_string_${type[0]}$${kind}$ - #:endfor + end procedure format_string_${type[0]}$_${kind}$ + + #:endfor + + #:for kind, type in CMPLX_KINDS_TYPES + !> Format ${type}$ variable as character sequence + module procedure format_string_${type[0]}$_${kind}$ - #:for kind, type in CMPLX_KINDS_TYPES - module procedure format_string_${type[0]}$${kind}$ - !! Format ${type}$ variable as character sequence + string = '(' // format_string_r_${kind}$(val%re, fmt) // ',' // & + & format_string_r_${kind}$(val%im, fmt) // ')' - string = '('//format_string_r${kind}$(val%re, fmt)//','// & - format_string_r${kind}$(val%im, fmt)//')' + end procedure format_string_${type[0]}$_${kind}$ - end procedure format_string_${type[0]}$${kind}$ - #:endfor + #:endfor end submodule stdlib_strings_format_string diff --git a/src/tests/string/CMakeLists.txt b/src/tests/string/CMakeLists.txt index 4e5db15e2..13ae0baab 100644 --- a/src/tests/string/CMakeLists.txt +++ b/src/tests/string/CMakeLists.txt @@ -5,4 +5,4 @@ ADDTEST(string_match) ADDTEST(string_derivedtype_io) ADDTEST(string_functions) ADDTEST(string_strip_chomp) -ADDTEST(strings_format_string) +ADDTEST(string_format_string) diff --git a/src/tests/string/Makefile.manual b/src/tests/string/Makefile.manual index 7ab5e5765..80dacbd0b 100644 --- a/src/tests/string/Makefile.manual +++ b/src/tests/string/Makefile.manual @@ -5,7 +5,7 @@ PROGS_SRC = test_string_assignment.f90 \ test_string_match.f90 \ test_string_operator.f90 \ test_string_strip_chomp.f90 \ - test_strings_format_string.f90 + test_string_format_string.f90 include ../Makefile.manual.test.mk diff --git a/src/tests/string/test_string_format_string.f90 b/src/tests/string/test_string_format_string.f90 new file mode 100644 index 000000000..d5d43b313 --- /dev/null +++ b/src/tests/string/test_string_format_string.f90 @@ -0,0 +1,113 @@ +! SPDX-Identifier: MIT +module test_string_format_string + use stdlib_strings, only: format_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_format_string_complex + call check_formatter(format_string((1, 1)), "(1.0", & + & "Default formatter for complex number", partial=.true.) + call check_formatter(format_string((1, 1), '(F6.2)'), "( 1.00, 1.00)", & + & "Formatter for complex number") + call check_formatter(format_string((-1, -1), '(F6.2)'), "( -1.00, -1.00)", & + & "Formatter for negative complex number") + call check_formatter(format_string((1, 1), '(SP,F6.2)'), "( +1.00, +1.00)", & + & "Formatter with sign control descriptor for complex number") + call check_formatter(format_string((1, 1), '(F6.2)') // format_string((2, 2), '(F7.3)'), & + & "( 1.00, 1.00)( 2.000, 2.000)", & + & "Multiple formatters for complex numbers") + + end subroutine test_format_string_complex + + subroutine test_format_string_integer + call check_formatter(format_string(100), "100", & + & "Default formatter for integer number") + call check_formatter(format_string(100, '(I6)'), " 100", & + & "Formatter for integer number") + call check_formatter(format_string(100, '(I0.6)'), "000100", & + & "Formatter with zero padding for integer number") + call check_formatter(format_string(100, '(I6)') // format_string(1000, '(I7)'), & + & " 100 1000", "Multiple formatters for integers") + call check_formatter(format_string(34, '(B8)'), " 100010", & + & "Binary formatter for integer number") + call check_formatter(format_string(34, '(O0.3)'), "042", & + & "Octal formatter with zero padding for integer number") + call check_formatter(format_string(34, '(Z3)'), " 22", & + & "Hexadecimal formatter for integer number") + + end subroutine test_format_string_integer + + subroutine test_format_string_real + call check_formatter(format_string(100.), "100.0", & + & "Default formatter for real number", partial=.true.) + call check_formatter(format_string(100., '(F6.2)'), "100.00", & + & "Formatter for real number") + call check_formatter(format_string(289., '(E7.2)'), ".29E+03", & + & "Exponential formatter with rounding for real number") + call check_formatter(format_string(128., '(ES8.2)'), "1.28E+02", & + & "Exponential formatter for real number") + + ! Wrong demonstration + call check_formatter(format_string(-100., '(F6.2)'), "*", & + & "Too narrow formatter for signed real number", partial=.true.) + call check_formatter(format_string(1000., '(F6.3)'), "*", & + & "Too narrow formatter for real number", partial=.true.) + call check_formatter(format_string(1000., '(7.3)'), "*", & + & "Invalid formatter for real number", partial=.true.) + + end subroutine test_format_string_real + + subroutine test_format_string_logical + call check_formatter(format_string(.true.), "T", & + & "Default formatter for logcal value") + call check_formatter(format_string(.true., '(L2)'), " T", & + & "Formatter for logical value") + call check_formatter(format_string(.false., '(L2)') // format_string(.true., '(L5)'), & + & " F T", "Multiple formatters for logical values") + + ! Wrong demonstration + call check_formatter(format_string(.false., '(1x)'), "*", & + & "Invalid formatter for logical value", partial=.true.) + + end subroutine test_format_string_logical + + +end module test_string_format_string + +program tester + use test_string_format_string + implicit none + + call test_format_string_complex + call test_format_string_integer + call test_format_string_logical + call test_format_string_real + +end program tester diff --git a/src/tests/string/test_strings_format_string.f90 b/src/tests/string/test_strings_format_string.f90 deleted file mode 100644 index 9f978f45a..000000000 --- a/src/tests/string/test_strings_format_string.f90 +++ /dev/null @@ -1,82 +0,0 @@ -program test_strings_format_string - use stdlib_strings, only: format_string, starts_with - use stdlib_error, only: check - use stdlib_optval, only: optval - implicit none - print *, 'format_string(complex) : ' - call check_formatter(format_string((1, 1)), "(1.0", & - & "Default formatter for complex number", partial=.true.) - call check_formatter(format_string((1, 1), '(F6.2)'), "( 1.00, 1.00)", & - & "Formatter for complex number") - call check_formatter(format_string((-1, -1), '(F6.2)'), "( -1.00, -1.00)", & - & "Formatter for negative complex number") - call check_formatter(format_string((1, 1), '(SP,F6.2)'), "( +1.00, +1.00)", & - & "Formatter with sign control descriptor for complex number") - call check_formatter(format_string((1, 1), '(F6.2)')//format_string((2, 2), '(F7.3)'), & - & "( 1.00, 1.00)( 2.000, 2.000)", & - & "Multiple formatters for complex numbers") - print *, 'format_string(integer) : ' - call check_formatter(format_string(100), "100", & - & "Default formatter for integer number") - call check_formatter(format_string(100, '(I6)'), " 100", & - & "Formatter for integer number") - call check_formatter(format_string(100, '(I0.6)'), "000100", & - & "Formatter with zero padding for integer number") - call check_formatter(format_string(100, '(I6)')//format_string(1000, '(I7)'), & - & " 100 1000", & - & "Multiple formatters for integers") - call check_formatter(format_string(34, '(B8)'), " 100010", & - & "Binary formatter for integer number") - call check_formatter(format_string(34, '(O0.3)'), "042", & - & "Octal formatter with zero padding for integer number") - call check_formatter(format_string(34, '(Z3)'), " 22", & - & "Hexadecimal formatter for integer number") - print *, 'format_string(real) : ' - call check_formatter(format_string(100.), "100.0", & - & "Default formatter for real number", partial=.true.) - call check_formatter(format_string(100., '(F6.2)'), "100.00", & - & "Formatter for real number") - call check_formatter(format_string(289., '(E7.2)'), ".29E+03", & - & "Exponential formatter with rounding for real number") - call check_formatter(format_string(128., '(ES8.2)'), "1.28E+02", & - & "Exponential formatter for real number") - ! Wrong demonstration - call check_formatter(format_string(-100., '(F6.2)'), "*", & - & "Too narrow formatter for signed real number", partial=.true.) - call check_formatter(format_string(1000., '(F6.3)'), "*", & - & "Too narrow formatter for real number", partial=.true.) - call check_formatter(format_string(1000., '(7.3)'), "*", & - & "Invalid formatter for real number", partial=.true.) - print *, 'format_string(logical) : ' - call check_formatter(format_string(.true.), "T", & - & "Default formatter for logcal value") - call check_formatter(format_string(.true., '(L2)'), " T", & - & "Formatter for logical value") - call check_formatter(format_string(.false., '(L2)')//format_string(.true., '(L5)'), & - & " F T", & - & "Multiple formatters for logical values") - ! Wrong demonstration - call check_formatter(format_string(.false., '(1x)'), "*", & - & "Invalid formatter for logical value", partial=.true.) - -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 -end program test_strings_format_string