Add format_string routine to format other types to strings

doc/specs/stdlib_strings.md

@@ -328,3 +328,82 @@ program demo_find
 
 end program demo_find
 ```
+
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `format_string`
+
+#### Description
+
+Format or transfer a integer/real/complex/logical variable as a character sequence.
+
+
+#### Syntax
+
+`format_string = [[stdlib_strings(module):format_string(interface)]] (value [, format])`
+
+#### Status
+
+Experimental
+
+#### Class
+
+Pure function
+
+#### Argument
+
+- `value`: Integer/real/complex/logical scalar.
+  This argument is intent(in).
+- `format`: Character scalar like `'(F6.2)'`.
+  This argument is intent(in) and optional.
+
+#### Result value
+
+The result is a allocatable length Character scalar.
+
+#### Example
+
+```fortran
+program demo_strings_format_string
+    use, non_intrinsic :: stdlib_strings, only: format_string
+    implicit none
+    print *, 'format_string(complex) : '
+        print *, format_string((1, 1))
+        print *, format_string((1, 1), '(F6.2)')
+        print *, format_string((1, 1), '(F6.2)'), format_string((2, 2), '(F7.3)')
+    print *, 'format_string(integer) : '
+        print *, format_string(100)
+        print *, format_string(100, '(I6)')
+        print *, format_string(100, '(I6)'), format_string(1000, '(I7)')
+    print *, 'format_string(real) : '
+        print *, format_string(100.)
+        print *, format_string(100., '(F12.2)')
+        print *, format_string(100., '(F6.2)'), &
+                    format_string(1000., '(F7.3)'), format_string(1000, '(F7.3)')
+                        !! Wrong demonstration
+    print *, 'format_string(logical) : '
+        print *, format_string(.true.)
+        print *, format_string(.true., '(L2)')
+        print *, format_string(.false., '(L2)'), format_string(.true., '(L5)'), &
+                    format_string(.false., '(I5)')
+                        !! Wrong demonstration
+end program demo_strings_format_string
+```
+**Results**
+```fortran
+ format_string(complex) :
+  (1.00000000,1.00000000)
+  (  1.00,  1.00)
+  (  1.00,  1.00) (  2.000,  2.000)
+ format_string(integer) :
+ 100
+    100
+    100   1000
+ format_string(real) :
+ 100.000000
+       100.00
+ 100.00********
+ format_string(logical) :
+ T
+  T
+  F    T*
+```

src/CMakeLists.txt

@@ -29,6 +29,8 @@ set(fppFiles
     stdlib_stats_distribution_PRNG.fypp
     stdlib_math.fypp
     stdlib_string_type.fypp
+    stdlib_strings_format_string.fypp
+    stdlib_strings.fypp
 )
 
 
@@ -47,7 +49,6 @@ set(SRC
     stdlib_error.f90
     stdlib_kinds.f90
     stdlib_logger.f90
-    stdlib_strings.f90
     stdlib_system.F90
     ${outFiles}
 )

src/Makefile.manual

@@ -25,13 +25,14 @@ SRCFYPP =\
         stdlib_stats_var.fypp \
         stdlib_math.fypp \
         stdlib_stats_distribution_PRNG.fypp \
-        stdlib_string_type.fypp
+        stdlib_string_type.fypp \
+        stdlib_strings.fypp \
+        stdlib_strings_format_string.fypp
 
 SRC = f18estop.f90 \
       stdlib_error.f90 \
       stdlib_kinds.f90 \
       stdlib_logger.f90 \
-      stdlib_strings.f90 \
       $(SRCGEN)
 
 LIB = libstdlib.a
@@ -129,5 +130,7 @@ stdlib_string_type.o: stdlib_ascii.o \
     stdlib_kinds.o
 stdlib_strings.o: stdlib_ascii.o \
     stdlib_string_type.o \
-	stdlib_optval.o
+	stdlib_optval.o \
+    stdlib_kinds.o
 stdlib_math.o: stdlib_kinds.o
+stdlib_strings_format_string.o: stdlib_strings.o

src/stdlib_strings.f90 → src/stdlib_strings.fypp

@@ -1,19 +1,36 @@
 ! SPDX-Identifier: MIT
-
+#:include "common.fypp"
+#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES &
+    & + CMPLX_KINDS_TYPES
 !> This module implements basic string handling routines.
 !>
 !> 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
     use stdlib_optval, only: optval
+    use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64, lk, c_bool
     implicit none
     private
 
+    public :: format_string
     public :: strip, chomp
     public :: starts_with, ends_with
     public :: slice, find
 
+    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
+            ${type}$, intent(in) :: val
+            character(len=*), intent(in), optional :: fmt
+        end function format_string_${type[0]}$${kind}$
+        #:endfor
+    end interface format_string
 
     !> Remove leading and trailing whitespace characters.
     !>

src/stdlib_strings_format_string.fypp

@@ -0,0 +1,38 @@
+#:include "common.fypp"
+#:set RIL_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES
+submodule (stdlib_strings) stdlib_strings_format_string
+
+    implicit none
+    integer, parameter :: buffer_len = 512
+
+contains
+
+    #:for kind, type in RIL_KINDS_TYPES
+    module procedure format_string_${type[0]}$${kind}$
+        !! Format ${type}$ variable as character sequence
+        character(len=buffer_len) :: buffer
+        integer :: stat
+
+        write(buffer, optval(fmt, "(g0)"), iostat=stat) val
+        if (stat == 0) then
+            string = trim(buffer)
+        else
+            string = '*'
+                !!\TODO: *?
+        end if
+
+    end procedure format_string_${type[0]}$${kind}$
+    #:endfor
+
+    #:for kind, type in CMPLX_KINDS_TYPES
+    module procedure format_string_${type[0]}$${kind}$
+        !! Format ${type}$ variable as character sequence
+        character(len=buffer_len) :: buffer
+
+        string = '('//format_string_r${kind}$(val%re, fmt)//','// &
+            format_string_r${kind}$(val%im, fmt)//')'
+
+    end procedure format_string_${type[0]}$${kind}$
+    #:endfor
+
+end submodule stdlib_strings_format_string

src/tests/string/CMakeLists.txt

@@ -5,3 +5,4 @@ ADDTEST(string_match)
 ADDTEST(string_derivedtype_io)
 ADDTEST(string_functions)
 ADDTEST(string_strip_chomp)
+ADDTEST(strings_format_string)

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_strings_format_string.f90
 
 
 include ../Makefile.manual.test.mk

src/tests/string/test_strings_format_string.f90

@@ -0,0 +1,82 @@
+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.00000000,1.00000000)", &
+        & "Default formatter for complex number")
+    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.000000", &
+        & "Default formatter for real number")
+    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, '(F7.3)'), "*", &
+        & "Real formatter for integer 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., '(I5)'), "*", &
+        & "Integer 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