diff --git a/doc/specs/index.md b/doc/specs/index.md index 4a1e3a919..098f2ce21 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -22,6 +22,7 @@ This is and index/directory of the specifications (specs) for each new module/fe - [stats](./stdlib_stats.html) - Descriptive Statistics - [stats_distribution_PRNG](./stdlib_stats_distribution_PRNG.html) - Probability Distributions random number generator - [string\_type](./stdlib_string_type.html) - Basic string support + - [strings](./stdlib_strings.html) - String handling and manipulation routines ## Missing specs diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md new file mode 100644 index 000000000..8045d673a --- /dev/null +++ b/doc/specs/stdlib_strings.md @@ -0,0 +1,110 @@ +--- +title: string handling +--- + +# The `stdlib_strings` module + +[TOC] + +## Introduction + +The `stdlib_strings` module provides basic string handling and manipulation routines. + + +## Procedures and methods provided + + + +### `strip` + +#### Description + +Remove leading and trailing whitespace characters. + +#### Syntax + +`string = [[stdlib_strings(module):strip(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `string`: Character scalar or [[stdlib_string_type(module):string_type(type)]]. + This argument is intent(in). + +#### Result value + +The result is of the same type as `string`. + +#### Example + +```fortran +program demo + use stdlib_ascii, only : TAB, VT, NUL, LF, CR, FF + use stdlib_strings, only : strip + implicit none + print'(a)', strip(" hello ") ! "hello" + print'(a)', strip(TAB//"goodbye"//CR//LF) ! "goodbye" + print'(a)', strip(" "//TAB//LF//VT//FF//CR) ! "" + print'(a)', strip(" ! ")//"!" ! "!!" + print'(a)', strip("Hello") ! "Hello" +end program demo +``` + + + +### `chomp` + +#### Description + +Remove trailing characters in *set* or *substring* from *string*. +If no character *set* or *substring* is provided trailing whitespace is removed. + +#### Syntax + +`string = [[stdlib_strings(module):chomp(interface)]] (string[, set|substring])` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `string`: Character scalar or [[stdlib_string_type(module):string_type(type)]]. + This argument is intent(in). +- `set`: Array of length one character. This argument is intent(in). +- `substring`: Character scalar or [[stdlib_string_type(module):string_type(type)]]. + This argument is intent(in). + +#### Result value + +The result is of the same type as `string`. + +#### Example + +```fortran +program demo + use stdlib_ascii, only : TAB, VT, NUL, LF, CR, FF + use stdlib_strings, only : chomp + implicit none + print'(a)', chomp(" hello ") ! " hello" + print'(a)', chomp(TAB//"goodbye"//CR//LF) ! "\tgoodbye" + print'(a)', chomp(" "//TAB//LF//VT//FF//CR) ! "" + print'(a)', chomp(" ! ")//"!" ! " !!" + print'(a)', chomp("Hello") ! "Hello" + print'(a)', chomp("hello", ["l", "o"]) ! "he" + print'(a)', chomp("hello", set=["l", "o"]) ! "he" + print'(a)', chomp("hello", "lo") ! "hel" + print'(a)', chomp("hello", substring="lo") ! "hel" +end program demo +``` diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 85f5c68b6..96a6ebcce 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -42,6 +42,7 @@ set(SRC stdlib_kinds.f90 stdlib_logger.f90 stdlib_string_type.f90 + stdlib_strings.f90 stdlib_system.F90 ${outFiles} ) diff --git a/src/Makefile.manual b/src/Makefile.manual index b59340b8c..85541e038 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -25,6 +25,7 @@ SRC = f18estop.f90 \ stdlib_error.f90 \ stdlib_kinds.f90 \ stdlib_logger.f90 \ + stdlib_strings.f90 \ stdlib_string_type.f90 \ $(SRCGEN) @@ -109,4 +110,5 @@ stdlib_stats_var.o: \ stdlib_stats_distribution_PRNG.o: \ stdlib_kinds.o \ stdlib_error.o -stdlib_string_type.o: stdlib_ascii.o \ No newline at end of file +stdlib_string_type.o: stdlib_ascii.o +stdlib_strings.o: stdlib_ascii.o stdlib_string_type.o diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 new file mode 100644 index 000000000..8b0468dd8 --- /dev/null +++ b/src/stdlib_strings.f90 @@ -0,0 +1,176 @@ +! SPDX-Identifier: MIT + +!> 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 + implicit none + private + + public :: strip, chomp + + + !> Remove leading and trailing whitespace characters. + !> + !> Version: experimental + interface strip + module procedure :: strip_string + module procedure :: strip_char + end interface strip + + !> Remove trailing characters in set from string. + !> If no character set is provided trailing whitespace is removed. + !> + !> Version: experimental + interface chomp + module procedure :: chomp_string + module procedure :: chomp_char + module procedure :: chomp_set_string_char + module procedure :: chomp_set_char_char + module procedure :: chomp_substring_string_string + module procedure :: chomp_substring_char_string + module procedure :: chomp_substring_string_char + module procedure :: chomp_substring_char_char + end interface chomp + + +contains + + + !> Remove leading and trailing whitespace characters. + pure function strip_string(string) result(stripped_string) + ! Avoid polluting the module scope and use the assignment only in this scope + use stdlib_string_type, only : assignment(=) + type(string_type), intent(in) :: string + type(string_type) :: stripped_string + + stripped_string = strip(char(string)) + end function strip_string + + !> Remove leading and trailing whitespace characters. + pure function strip_char(string) result(stripped_string) + character(len=*), intent(in) :: string + character(len=:), allocatable :: stripped_string + integer :: first, last + + first = verify(string, whitespace) + if (first == 0) then + stripped_string = "" + else + last = verify(string, whitespace, back=.true.) + stripped_string = string(first:last) + end if + + end function strip_char + + + !> Remove trailing characters in set from string. + !> Default character set variant where trailing whitespace is removed. + pure function chomp_string(string) result(chomped_string) + ! Avoid polluting the module scope and use the assignment only in this scope + use stdlib_string_type, only : assignment(=) + type(string_type), intent(in) :: string + type(string_type) :: chomped_string + integer :: last + + last = verify(string, whitespace, back=.true.) + chomped_string = char(string, 1, last) + end function chomp_string + + !> Remove trailing characters in set from string. + !> Default character set variant where trailing whitespace is removed. + pure function chomp_char(string) result(chomped_string) + character(len=*), intent(in) :: string + character(len=:), allocatable :: chomped_string + integer :: last + + last = verify(string, whitespace, back=.true.) + chomped_string = string(1:last) + end function chomp_char + + !> Remove trailing characters in set from string. + pure function chomp_set_string_char(string, set) result(chomped_string) + ! Avoid polluting the module scope and use the assignment only in this scope + use stdlib_string_type, only : assignment(=) + type(string_type), intent(in) :: string + character(len=1), intent(in) :: set(:) + type(string_type) :: chomped_string + + chomped_string = chomp(char(string), set) + end function chomp_set_string_char + + !> Remove trailing characters in set from string. + pure function chomp_set_char_char(string, set) result(chomped_string) + character(len=*), intent(in) :: string + character(len=1), intent(in) :: set(:) + character(len=:), allocatable :: chomped_string + integer :: last + + last = verify(string, set_to_string(set), back=.true.) + chomped_string = string(1:last) + + end function chomp_set_char_char + + !> Remove trailing substrings from string. + pure function chomp_substring_string_string(string, substring) result(chomped_string) + ! Avoid polluting the module scope and use the assignment only in this scope + use stdlib_string_type, only : assignment(=) + type(string_type), intent(in) :: string + type(string_type), intent(in) :: substring + type(string_type) :: chomped_string + + chomped_string = chomp(char(string), char(substring)) + end function chomp_substring_string_string + + !> Remove trailing substrings from string. + pure function chomp_substring_string_char(string, substring) result(chomped_string) + ! Avoid polluting the module scope and use the assignment only in this scope + use stdlib_string_type, only : assignment(=) + type(string_type), intent(in) :: string + character(len=*), intent(in) :: substring + type(string_type) :: chomped_string + + chomped_string = chomp(char(string), substring) + end function chomp_substring_string_char + + !> Remove trailing substrings from string. + pure function chomp_substring_char_string(string, substring) result(chomped_string) + character(len=*), intent(in) :: string + type(string_type), intent(in) :: substring + character(len=:), allocatable :: chomped_string + + chomped_string = chomp(string, char(substring)) + end function chomp_substring_char_string + + !> Remove trailing substrings from string. + pure function chomp_substring_char_char(string, substring) result(chomped_string) + character(len=*), intent(in) :: string + character(len=*), intent(in) :: substring + character(len=:), allocatable :: chomped_string + integer :: last, nsub + + last = len(string) + nsub = len(substring) + if (nsub > 0) then + do while(string(last-nsub+1:last) == substring) + last = last - nsub + end do + end if + chomped_string = string(1:last) + + end function chomp_substring_char_char + + !> Implementation to transfer a set of characters to a string representing the set. + !> + !> This function is internal and not part of the public API. + pure function set_to_string(set) result(string) + character(len=1), intent(in) :: set(:) + character(len=size(set)) :: string + + string = transfer(set, string) + end function set_to_string + + +end module stdlib_strings diff --git a/src/tests/string/CMakeLists.txt b/src/tests/string/CMakeLists.txt index 6e3908ca7..b875c2d7a 100644 --- a/src/tests/string/CMakeLists.txt +++ b/src/tests/string/CMakeLists.txt @@ -3,4 +3,4 @@ ADDTEST(string_operator) ADDTEST(string_intrinsic) ADDTEST(string_derivedtype_io) ADDTEST(string_functions) - +ADDTEST(string_strip_chomp) diff --git a/src/tests/string/Makefile.manual b/src/tests/string/Makefile.manual index be5bb9f44..1dcf91d78 100644 --- a/src/tests/string/Makefile.manual +++ b/src/tests/string/Makefile.manual @@ -2,7 +2,8 @@ PROGS_SRC = test_string_assignment.f90 \ test_string_derivedtype_io.f90 \ test_string_functions.f90 \ test_string_intrinsic.f90 \ - test_string_operator.f90 + test_string_operator.f90 \ + test_string_strip_chomp.f90 include ../Makefile.manual.test.mk diff --git a/src/tests/string/test_string_strip_chomp.f90 b/src/tests/string/test_string_strip_chomp.f90 new file mode 100644 index 000000000..5a0585bb7 --- /dev/null +++ b/src/tests/string/test_string_strip_chomp.f90 @@ -0,0 +1,110 @@ +! SPDX-Identifier: MIT +module test_strip_chomp + use stdlib_ascii, only : TAB, VT, NUL, LF, CR, FF + use stdlib_error, only : check + use stdlib_strings, only : strip, chomp + use stdlib_string_type, only : string_type, operator(==), operator(//) + implicit none + +contains + + subroutine test_strip_char + call check(strip(" hello ") == "hello") + call check(strip(TAB//"goodbye"//CR//LF) == "goodbye") + call check(strip(NUL//TAB//LF//VT//FF//CR) == NUL) + call check(strip(" "//TAB//LF//VT//FF//CR) == "") + call check(strip(" ! ")//"!" == "!!") + call check(strip("Hello") == "Hello") + end subroutine test_strip_char + + subroutine test_strip_string + call check(strip(string_type(" hello ")) == "hello") + call check(strip(string_type(TAB//"goodbye"//CR//LF)) == "goodbye") + call check(strip(string_type(NUL//TAB//LF//VT//FF//CR)) == NUL) + call check(strip(string_type(" "//TAB//LF//VT//FF//CR)) == "") + call check(strip(string_type(" ! "))//"!" == "!!") + call check(strip(string_type("Hello")) == "Hello") + end subroutine test_strip_string + + subroutine test_chomp_char + call check(chomp("hello") == "hello") + call check(chomp("hello"//LF) == "hello", "1") + call check(chomp("hello"//CR//LF) == "hello", "2") + call check(chomp("hello"//LF//CR) == "hello", "3") + call check(chomp("hello"//CR) == "hello", "4") + call check(chomp("hello "//LF//" there") == "hello "//LF//" there") + call check(chomp("hello"//CR//LF//CR//LF) == "hello") + call check(chomp("hello"//CR//LF//CR//CR//LF) == "hello") + call check(chomp(NUL//TAB//LF//VT//FF//CR) == NUL) + call check(chomp(" "//TAB//LF//VT//FF//CR) == "") + call check(chomp(" ! ")//"!" == " !!") + end subroutine test_chomp_char + + subroutine test_chomp_string + call check(chomp(string_type("hello")) == "hello") + call check(chomp(string_type("hello"//LF)) == "hello") + call check(chomp(string_type("hello"//CR//LF)) == "hello") + call check(chomp(string_type("hello"//LF//CR)) == "hello") + call check(chomp(string_type("hello"//CR)) == "hello") + call check(chomp(string_type("hello "//LF//" there")) == "hello "//LF//" there") + call check(chomp(string_type("hello"//CR//LF//CR//LF)) == "hello") + call check(chomp(string_type("hello"//CR//LF//CR//CR//LF)) == "hello") + call check(chomp(string_type(NUL//TAB//LF//VT//FF//CR)) == NUL) + call check(chomp(string_type(" "//TAB//LF//VT//FF//CR)) == "") + call check(chomp(string_type(" ! "))//"!" == " !!") + end subroutine test_chomp_string + + subroutine test_chomp_set_char + call check(chomp("hello", ["l", "o"]) == "he") + call check(chomp("hello", set=["l", "o"]) == "he") + end subroutine test_chomp_set_char + + subroutine test_chomp_set_string + call check(chomp(string_type("hello"), ["l", "o"]) == "he") + call check(chomp(string_type("hello"), set=["l", "o"]) == "he") + call check(chomp("hellooooo", ["o", "o"]) == "hell") + call check(chomp("hellooooo", set=["o", "o"]) == "hell") + end subroutine test_chomp_set_string + + subroutine test_chomp_substring_char + call check(chomp("hello", "") == "hello") + call check(chomp("hello", substring="") == "hello") + call check(chomp("hello", "lo") == "hel") + call check(chomp("hello", substring="lo") == "hel") + call check(chomp("hellooooo", "oo") == "hello") + call check(chomp("hellooooo", substring="oo") == "hello") + end subroutine test_chomp_substring_char + + subroutine test_chomp_substring_string + call check(chomp(string_type("hello"), "") == "hello") + call check(chomp(string_type("hello"), substring="") == "hello") + call check(chomp(string_type("hello"), "lo") == "hel") + call check(chomp(string_type("hello"), substring="lo") == "hel") + call check(chomp("hello", string_type("lo")) == "hel") + call check(chomp("hello", substring=string_type("lo")) == "hel") + call check(chomp(string_type("hello"), string_type("lo")) == "hel") + call check(chomp(string_type("hello"), substring=string_type("lo")) == "hel") + call check(chomp(string_type("hellooooo"), "oo") == "hello") + call check(chomp(string_type("hellooooo"), substring="oo") == "hello") + call check(chomp("hellooooo", string_type("oo")) == "hello") + call check(chomp("hellooooo", substring=string_type("oo")) == "hello") + call check(chomp(string_type("hellooooo"), string_type("oo")) == "hello") + call check(chomp(string_type("hellooooo"), substring=string_type("oo")) == "hello") + end subroutine test_chomp_substring_string + +end module test_strip_chomp + +program tester + use test_strip_chomp + implicit none + + call test_strip_char + call test_strip_string + call test_chomp_char + call test_chomp_string + call test_chomp_set_char + call test_chomp_set_string + call test_chomp_substring_char + call test_chomp_substring_string + +end program tester