Implement non-fancy functional string type

- support all intrinsic operators for character variables
  (llt, lgt, lle, lge, len, len_trim, trim, adjustl, adjustr,
  index, scan, verify, repeat, char, ichar, iachar)
- support derived type IO (formatted and unformatted)
- implement assignment from character values
- implement constructing string from character values

Author: awvwgk

doc/specs/index.md

@@ -20,6 +20,7 @@ This is and index/directory of the specifications (specs) for each new module/fe
  - [quadrature](./stdlib_quadrature.html) - Numerical integration
  - [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
 
 ## Missing specs
 

doc/specs/stdlib_string_type.md

@@ -41,6 +41,7 @@ set(SRC
     stdlib_error.f90
     stdlib_kinds.f90
     stdlib_logger.f90
+    stdlib_string_type.f90
     stdlib_system.F90
     ${outFiles}
 )

src/CMakeLists.txt

@@ -25,6 +25,7 @@ SRC = f18estop.f90 \
       stdlib_error.f90 \
       stdlib_kinds.f90 \
       stdlib_logger.f90 \
+      stdlib_string_type.f90 \
       $(SRCGEN)
 
 LIB = libstdlib.a

src/Makefile.manual

@@ -13,6 +13,7 @@ add_subdirectory(linalg)
 add_subdirectory(logger)
 add_subdirectory(optval)
 add_subdirectory(stats)
+add_subdirectory(string)
 add_subdirectory(system)
 add_subdirectory(quadrature)
 

src/stdlib_string_type.f90

@@ -8,6 +8,7 @@ all:
 	$(MAKE) -f Makefile.manual --directory=optval
 	$(MAKE) -f Makefile.manual --directory=quadrature
 	$(MAKE) -f Makefile.manual --directory=stats
+	$(MAKE) -f Makefile.manual --directory=string
 
 test:
 	$(MAKE) -f Makefile.manual --directory=ascii test
@@ -17,6 +18,7 @@ test:
 	$(MAKE) -f Makefile.manual --directory=optval test
 	$(MAKE) -f Makefile.manual --directory=quadrature test
 	$(MAKE) -f Makefile.manual --directory=stats test
+	$(MAKE) -f Makefile.manual --directory=string test
 
 clean:
 	$(MAKE) -f Makefile.manual --directory=ascii clean
@@ -25,3 +27,4 @@ clean:
 	$(MAKE) -f Makefile.manual --directory=logger clean
 	$(MAKE) -f Makefile.manual --directory=optval clean
 	$(MAKE) -f Makefile.manual --directory=stats clean
+	$(MAKE) -f Makefile.manual --directory=string clean

src/tests/CMakeLists.txt

@@ -0,0 +1,5 @@
+ADDTEST(string_assignment)
+ADDTEST(string_operator)
+ADDTEST(string_intrinsic)
+ADDTEST(string_derivedtype_io)
+

src/tests/Makefile.manual

@@ -0,0 +1,7 @@
+PROGS_SRC = test_string_assignment.f90 \
+            test_string_derivedtype_io.f90 \
+            test_string_intrinsic.f90 \
+            test_string_operator.f90
+
+
+include ../Makefile.manual.test.mk

src/tests/string/CMakeLists.txt

@@ -0,0 +1,27 @@
+! SPDX-Identifier: MIT
+module test_string_assignment
+    use stdlib_error, only : check
+    use stdlib_string_type, only : string_type, assignment(=), len
+    implicit none
+
+contains
+
+    subroutine test_assignment
+        type(string_type) :: string
+
+        call check(len(string) == 0)
+
+        string = "Sequence"
+        call check(len(string) == 8)
+    end subroutine test_assignment
+
+end module test_string_assignment
+
+program tester
+    use test_string_assignment
+    implicit none
+
+    call test_assignment
+
+end program tester
+

src/tests/string/Makefile.manual

@@ -0,0 +1,80 @@
+! SPDX-Identifer: MIT
+module test_string_derivedtype_io
+    use stdlib_error, only : check
+    use stdlib_string_type, only : string_type, assignment(=), len, &
+        write(formatted), read(formatted), write(unformatted), read(unformatted), &
+        operator(.eq.)
+    implicit none
+
+contains
+
+    subroutine test_listdirected_io
+        type(string_type) :: string
+        integer :: io, stat
+        string = "Important saved value"
+
+        open(newunit=io, form="formatted", status="scratch")
+        write(io, *) string
+        write(io, *) ! Pad with a newline or we might run into EOF while reading
+
+        string = ""
+        rewind(io)
+
+        read(io, *, iostat=stat) string
+        close(io)
+
+        call check(stat == 0)
+        call check(len(string) == 21)
+        call check(string == "Important saved value")
+    end subroutine test_listdirected_io
+
+    subroutine test_formatted_io
+        type(string_type) :: string
+        integer :: io, stat
+        string = "Important saved value"
+
+        !open(newunit=io, form="formatted", status="scratch")
+        open(newunit=io, form="formatted", file="scratch.txt")
+        write(io, '(dt)') string
+        write(io, '(a)') ! Pad with a newline or we might run into EOF while reading
+
+        string = ""
+        rewind(io)
+
+        read(io, *, iostat=stat) string
+        close(io)
+
+        call check(stat == 0)
+        call check(len(string) == 21)
+        call check(string == "Important saved value")
+    end subroutine test_formatted_io
+
+    subroutine test_unformatted_io
+        type(string_type) :: string
+        integer :: io
+        string = "Important saved value"
+
+        open(newunit=io, form="unformatted", status="scratch")
+        write(io) string
+
+        string = ""
+        rewind(io)
+
+        read(io) string
+        close(io)
+
+        call check(len(string) == 21)
+        call check(string == "Important saved value")
+    end subroutine test_unformatted_io
+
+end module test_string_derivedtype_io
+
+program tester
+    use test_string_derivedtype_io
+    implicit none
+
+    call test_listdirected_io
+    call test_formatted_io
+    call test_unformatted_io
+
+end program tester

src/tests/string/test_string_assignment.f90

@@ -0,0 +1,239 @@
+! SPDX-Identifer: MIT
+module test_string_intrinsic
+    use stdlib_error, only : check
+    use stdlib_string_type
+    implicit none
+
+contains
+
+    subroutine test_lgt
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = lgt(string, "abc")
+        call check(res .eqv. .true.)
+
+        res = lgt(string, "bcd")
+        call check(res .eqv. .false.)
+
+        res = lgt(string, "cde")
+        call check(res .eqv. .false.)
+    end subroutine test_lgt
+
+    subroutine test_llt
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = llt(string, "abc")
+        call check(res .eqv. .false.)
+
+        res = llt(string, "bcd")
+        call check(res .eqv. .false.)
+
+        res = llt(string, "cde")
+        call check(res .eqv. .true.)
+    end subroutine test_llt
+
+    subroutine test_lge
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = lge(string, "abc")
+        call check(res .eqv. .true.)
+
+        res = lge(string, "bcd")
+        call check(res .eqv. .true.)
+
+        res = lge(string, "cde")
+        call check(res .eqv. .false.)
+    end subroutine test_lge
+
+    subroutine test_lle
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = lle(string, "abc")
+        call check(res .eqv. .false.)
+
+        res = lle(string, "bcd")
+        call check(res .eqv. .true.)
+
+        res = lle(string, "cde")
+        call check(res .eqv. .true.)
+    end subroutine test_lle
+
+    subroutine test_trim
+       type(string_type) :: string, trimmed_str
+
+       string = "Whitespace                            "
+       trimmed_str = trim(string)
+       call check(len(trimmed_str) == 10)
+    end subroutine test_trim
+
+    subroutine test_len
+        type(string_type) :: string
+        integer :: length
+
+        string = "Some longer sentence for this example."
+        length = len(string)
+        call check(length == 38)
+
+        string = "Whitespace                            "
+        length = len(string)
+        call check(length == 38)
+    end subroutine test_len
+
+    subroutine test_len_trim
+        type(string_type) :: string
+        integer :: length
+
+        string = "Some longer sentence for this example."
+        length = len_trim(string)
+        call check(length == 38)
+
+        string = "Whitespace                            "
+        length = len_trim(string)
+        call check(length == 10)
+    end subroutine test_len_trim
+
+    subroutine test_adjustl
+        type(string_type) :: string
+
+        string = "                            Whitespace"
+        string = adjustl(string)
+        call check(char(string) == "Whitespace                            ")
+    end subroutine test_adjustl
+
+    subroutine test_adjustr
+        type(string_type) :: string
+
+        string = "Whitespace                            "
+        string = adjustr(string)
+        call check(char(string) == "                            Whitespace")
+    end subroutine test_adjustr
+
+    subroutine test_scan
+        type(string_type) :: string
+        integer :: pos
+
+        string = "fortran"
+        pos = scan(string, "ao")
+        call check(pos == 2)
+
+        pos = scan(string, "ao", .true.)
+        call check(pos == 6)
+
+        pos = scan(string, "c++")
+        call check(pos == 0)
+    end subroutine test_scan
+
+    subroutine test_verify
+        type(string_type) :: string
+        integer :: pos
+
+        string = "fortran"
+        pos = verify(string, "ao")
+        call check(pos == 1)
+
+        pos = verify(string, "fo")
+        call check(pos == 3)
+
+        pos = verify(string, "c++")
+        call check(pos == 1)
+
+        pos = verify(string, "c++", back=.true.)
+        call check(pos == 7)
+
+        pos = verify(string, string)
+        call check(pos == 0)
+    end subroutine test_verify
+
+    subroutine test_repeat
+        type(string_type) :: string
+
+        string = "What? "
+        string = repeat(string, 3)
+        call check(string == "What? What? What? ")
+    end subroutine test_repeat
+
+    subroutine test_index
+        type(string_type) :: string
+        integer :: pos
+
+        string = "Search this string for this expression"
+        pos = index(string, "this")
+        call check(pos == 8)
+
+        pos = index(string, "this", back=.true.)
+        call check(pos == 24)
+
+        pos = index(string, "This")
+        call check(pos == 0)
+    end subroutine test_index
+
+    subroutine test_char
+        type(string_type) :: string
+        character(len=:), allocatable :: dlc
+        character(len=1), allocatable :: chars(:)
+
+        string = "Character sequence"
+        dlc = char(string)
+        call check(dlc == "Character sequence")
+
+        dlc = char(string, 3)
+        call check(dlc == "a")
+        chars = char(string, [3, 5, 8, 12, 14, 15, 18])
+        call check(all(chars == ["a", "a", "e", "e", "u", "e", "e"]))
+
+        string = "Fortran"
+        dlc = char(string, 1, 4)
+        call check(dlc == "Fort")
+    end subroutine test_char
+
+    subroutine test_ichar
+        type(string_type) :: string
+        integer :: code
+
+        string = "Fortran"
+        code = ichar(string)
+        call check(code == ichar("F"))
+    end subroutine test_ichar
+
+    subroutine test_iachar
+        type(string_type) :: string
+        integer :: code
+
+        string = "Fortran"
+        code = iachar(string)
+        call check(code == iachar("F"))
+    end subroutine test_iachar
+
+end module test_string_intrinsic
+
+program tester
+    use test_string_intrinsic
+    implicit none
+
+    call test_lgt
+    call test_llt
+    call test_lge
+    call test_lle
+    call test_trim
+    call test_len
+    call test_len_trim
+    call test_adjustl
+    call test_adjustr
+    call test_scan
+    call test_verify
+    call test_repeat
+    call test_index
+    call test_char
+    call test_ichar
+    call test_iachar
+
+end program tester
+

src/tests/string/test_string_derivedtype_io.f90

@@ -0,0 +1,123 @@
+! SPDX-Identifer: MIT
+module test_string_operator
+    use stdlib_error, only : check
+    use stdlib_string_type, only : string_type, assignment(=), len, &
+        operator(.gt.), operator(.lt.), operator(.ge.), operator(.le.), &
+        operator(.ne.), operator(.eq.), operator(//)
+    implicit none
+
+contains
+
+    subroutine test_gt
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = string > "abc"
+        call check(res .eqv. .true.)
+
+        res = string > "bcd"
+        call check(res .eqv. .false.)
+
+        res = string > "cde"
+        call check(res .eqv. .false.)
+    end subroutine test_gt
+
+    subroutine test_lt
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = string < "abc"
+        call check(res .eqv. .false.)
+
+        res = string < "bcd"
+        call check(res .eqv. .false.)
+
+        res = string < "cde"
+        call check(res .eqv. .true.)
+    end subroutine test_lt
+
+    subroutine test_ge
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = string >= "abc"
+        call check(res .eqv. .true.)
+
+        res = string >= "bcd"
+        call check(res .eqv. .true.)
+
+        res = string >= "cde"
+        call check(res .eqv. .false.)
+    end subroutine test_ge
+
+    subroutine test_le
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = string <= "abc"
+        call check(res .eqv. .false.)
+
+        res = string <= "bcd"
+        call check(res .eqv. .true.)
+
+        res = string <= "cde"
+        call check(res .eqv. .true.)
+    end subroutine test_le
+
+    subroutine test_eq
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = string == "abc"
+        call check(res .eqv. .false.)
+
+        res = string == "bcd"
+        call check(res .eqv. .true.)
+
+        res = string == "cde"
+        call check(res .eqv. .false.)
+    end subroutine test_eq
+
+    subroutine test_ne
+        type(string_type) :: string
+        logical :: res
+
+        string = "bcd"
+        res = string /= "abc"
+        call check(res .eqv. .true.)
+
+        res = string /= "bcd"
+        call check(res .eqv. .false.)
+
+        res = string /= "cde"
+        call check(res .eqv. .true.)
+    end subroutine test_ne
+
+    subroutine test_concat
+        type(string_type) :: string
+
+        string = "Hello, "
+        string = string // "World!"
+        call check(len(string) == 13)
+    end subroutine test_concat
+
+end module test_string_operator
+
+program tester
+    use test_string_operator
+    implicit none
+
+    call test_gt
+    call test_lt
+    call test_ge
+    call test_le
+    call test_eq
+    call test_ne
+    call test_concat
+
+end program tester