New zfill function to left-pad a string with zeros

doc/specs/stdlib_strings.md

@@ -421,6 +421,45 @@ The result is a scalar of integer type or an integer array of rank equal to the
 {!example/strings/example_count.f90!}
 ```
 
+
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `zfill`
+
+#### Description
+
+Returns a string of length `output_length` left padded with zeros.
+If `output_length` is less than or equal to the length of `string`, padding is not performed.
+
+#### Syntax
+
+`string = [[stdlib_strings(module):zfill(interface)]] (string, output_length)`
+
+#### Status
+
+Experimental
+
+#### Class
+
+Pure function
+
+#### Argument
+
+- `string`: Character scalar or [[stdlib_string_type(module):string_type(type)]].
+  This argument is intent(in).
+- `output_length`: integer.
+  This argument is intent(in).
+
+#### Result value
+
+The result is of the same type as `string`.
+
+#### Example
+
+```fortran
+{!example/strings/example_zfill.f90!}
+```
+
+
 <!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
 ### `to_string`
 

example/strings/CMakeLists.txt

@@ -9,3 +9,4 @@ ADD_EXAMPLE(slice)
 ADD_EXAMPLE(starts_with)
 ADD_EXAMPLE(strip)
 ADD_EXAMPLE(to_string)
+ADD_EXAMPLE(zfill)

example/strings/example_zfill.f90

@@ -0,0 +1,15 @@
+program example_zfill
+  use stdlib_string_type, only: string_type, assignment(=), write (formatted)
+  use stdlib_strings, only: zfill
+  implicit none
+  type(string_type) :: string
+
+  string = "left pad this string with zeros"
+! string <-- "left pad this string with zeros"
+
+  print '(dt)', zfill(string, 36) ! "00000left pad this string with zeros"
+
+  string = zfill(string, 36)
+! string <-- "00000left pad this string with zeros"
+
+end program example_zfill

src/stdlib_strings.fypp

@@ -14,7 +14,7 @@ module stdlib_strings
     public :: to_string
     public :: strip, chomp
     public :: starts_with, ends_with
-    public :: slice, find, replace_all, padl, padr, count
+    public :: slice, find, replace_all, padl, padr, count, zfill
 
     !> Version: experimental
     !>
@@ -155,6 +155,15 @@ module stdlib_strings
         module procedure :: count_char_char
     end interface count
 
+    !> Version: experimental
+    !>
+    !> Left pad the input string with zeros.
+    !> [Specifications](../page/specs/stdlib_strings.html#zfill)
+    interface zfill
+        module procedure :: zfill_string
+        module procedure :: zfill_char
+    end interface zfill
+
 contains
 
 
@@ -909,6 +918,30 @@ contains
         end if
 
     end function count_char_char
+
+    !> Left pad the input string with zeros
+    !>
+    !> Returns a new string
+    pure function zfill_string(string, output_length) result(res)
+        type(string_type), intent(in) :: string
+        integer, intent(in) :: output_length
+        type(string_type) :: res
+
+        res = string_type(padl(char(string), output_length, "0"))
+
+    end function zfill_string
+
+    !> Left pad the input string with zeros
+    !>
+    !> Returns a new string
+    pure function zfill_char(string, output_length) result(res)
+        character(len=*), intent(in) :: string
+        integer, intent(in) :: output_length
+        character(len=max(len(string), output_length)) :: res
+
+        res = padl(string, output_length, "0")
+
+    end function zfill_char
 
 
 end module stdlib_strings

test/string/test_string_functions.f90

@@ -4,7 +4,7 @@ module test_string_functions
     use testdrive, only : new_unittest, unittest_type, error_type, check
     use stdlib_string_type, only : string_type, assignment(=), operator(==), &
                                     to_lower, to_upper, to_title, to_sentence, reverse
-    use stdlib_strings, only: slice, find, replace_all, padl, padr, count
+    use stdlib_strings, only: slice, find, replace_all, padl, padr, count, zfill
     use stdlib_optval, only: optval
     use stdlib_strings, only : to_string
     implicit none
@@ -29,7 +29,8 @@ subroutine collect_string_functions(testsuite)
             new_unittest("replace_all", test_replace_all), &
             new_unittest("padl", test_padl), &
             new_unittest("padr", test_padr), &
-            new_unittest("count", test_count) &
+            new_unittest("count", test_count), &
+            new_unittest("zfill", test_zfill) &
             ]
     end subroutine collect_string_functions
 
@@ -659,6 +660,54 @@ subroutine test_count(error)
 
     end subroutine test_count
 
+    subroutine test_zfill(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+
+        type(string_type) :: test_string
+        character(len=:), allocatable :: test_char
+
+        test_string = "left pad this string"
+        test_char = "  left pad this string  "
+
+        ! output_length > len(string)
+        call check(error, zfill(test_string, 25) == "00000left pad this string", &
+            & 'zfill: output_length > len(string), test_case 1')
+        if (allocated(error)) return
+        call check(error, zfill(test_string, 22) == "00left pad this string", &
+            & 'zfill: output_length > len(string), test_case 2')
+        if (allocated(error)) return
+        call check(error, zfill(test_string, 23) == "000left pad this string", &
+            & 'zfill: output_length > len(string), test_case 3')
+        if (allocated(error)) return
+        call check(error, zfill(test_char, 26) == "00  left pad this string  ", &
+            & 'zfill: output_length > len(string), test_case 4')
+        if (allocated(error)) return
+        call check(error, zfill("", 10) == "0000000000", &
+            & 'zfill: output_length > len(string), test_case 5')
+        if (allocated(error)) return
+
+        ! output_length <= len(string)
+        call check(error, zfill(test_string, 18) == "left pad this string", &
+            & 'zfill: output_length <= len(string), test_case 1')
+        if (allocated(error)) return
+        call check(error, zfill(test_string, -4) == "left pad this string", &
+            & 'zfill: output_length <= len(string), test_case 2')
+        if (allocated(error)) return
+        call check(error, zfill(test_char, 20) == "  left pad this string  ", &
+            & 'zfill: output_length <= len(string), test_case 3')
+        if (allocated(error)) return
+        call check(error, zfill(test_char, 17) == "  left pad this string  ", &
+            & 'zfill: output_length <= len(string), test_case 4')
+        if (allocated(error)) return
+        call check(error, zfill("", 0) == "", &
+            & 'zfill: output_length <= len(string), test_case 5')
+        if (allocated(error)) return
+        call check(error, zfill("", -12) == "", &
+            & 'zfill: output_length <= len(string), test_case 6')
+
+    end subroutine test_zfill
+
 end module test_string_functions