From d3752b0025a85149132cd11d1e3d18ee60ccb349 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 11 Mar 2021 16:49:50 +0100 Subject: [PATCH] Provide abstract base class for a string object - provide full compatibility with the string_type - provide overloaded interfaces in the base class to define all character intrinsic functions for both character scalars and functional strings - add preliminary specs on the public API (not developer API) of the abstract base class - add tests to check a minimal implementation of a string class --- doc/specs/index.md | 1 + doc/specs/stdlib_string_class.md | 1172 ++++++++++++++++ src/CMakeLists.txt | 1 + src/Makefile.manual | 3 + src/stdlib_string_class.f90 | 1749 ++++++++++++++++++++++++ src/tests/string/CMakeLists.txt | 2 +- src/tests/string/Makefile.manual | 1 + src/tests/string/test_string_class.f90 | 774 +++++++++++ 8 files changed, 3702 insertions(+), 1 deletion(-) create mode 100644 doc/specs/stdlib_string_class.md create mode 100644 src/stdlib_string_class.f90 create mode 100644 src/tests/string/test_string_class.f90 diff --git a/doc/specs/index.md b/doc/specs/index.md index 4a1e3a919..b70bb606c 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 + - [string\_class](./stdlib_string_class.html) - Abstract base class for strings ## Missing specs diff --git a/doc/specs/stdlib_string_class.md b/doc/specs/stdlib_string_class.md new file mode 100644 index 000000000..0b73c365c --- /dev/null +++ b/doc/specs/stdlib_string_class.md @@ -0,0 +1,1172 @@ +--- +title: string class +--- + +# The `stdlib_string_class` module + +[TOC] + +## Introduction + +The `stdlib_string_class` provides an abstract base class (ABC) to create an +extendible string object to hold an arbitrary character sequence compatibile +with most Fortran intrinsic character procedures as well as compatibility +with the stdlib [[stdlib_string_type(module):string_type(type)]]. + + +## Derived types provides + + + +### The `string_class` derived type + +The `string_class` is defined as an abstract derived type representing a +sequence of characters. The internal representation of the character sequence +is decided by the class inheriting from the `string_class`. + +@note +The module provides the abstract base class and overloaded function interfaces +for the respective intrinsic functions. +Implementations of the string class should import all overloaded function interfaces +and reexport them to ease usage of the string implementation. +A minimal implementation must at least provide a setter as `assignment(=)`, +three getter functions (for the whole string, a specific index and a range) +as well as the length and trimmed length getter functions. +All other functionality is implemented by using the getter and setter functions in +the abstract base class, but implementations are encouraged to overwrite those with +procedures specific and optimal for their character sequence representation. + + +#### Status + +Experimental + + +#### Example + +```fortran +!> Minimal implementation of a string based on the stdlib string abstract base class +module string_implementation + use stdlib_string_class, only : string_class, & + len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl, & + lgt, lge, llt, lle, char, ichar, iachar + implicit none + private + + public :: my_string_type + public :: len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl + public :: lgt, lge, llt, lle, char, ichar, iachar + + !> Definition of a string class implementation + type, extends(string_class) :: my_string_type + private + character(len=:), allocatable :: raw + contains + !> Assign a character sequence to a string object. + procedure :: assign_object_char + !> Returns the length of the character sequence represented by the string. + procedure :: get_len + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + procedure :: get_len_trim + !> Return the character sequence represented by the string. + procedure :: get_char + !> Return the character sequence represented by the string. + procedure :: get_char_pos + !> Return the character sequence represented by the string. + procedure :: get_char_range + end type my_string_type + + !> Constructor for string class implementation + interface my_string_type + module procedure :: new_string + end interface my_string_type + +contains + + !> Constructor for new string instances from a scalar character value. + elemental function new_string(string) result(new) + character(len=*), intent(in), optional :: string + type(my_string_type) :: new + if (present(string)) then + new%raw = string + end if + end function new_string + + !> Assign a character sequence to a string object. + elemental subroutine assign_object_char(lhs, rhs) + class(my_string_type), intent(inout) :: lhs + character(len=*), intent(in) :: rhs + lhs%raw = rhs + end subroutine assign_object_char + + !> Returns the length of the character sequence represented by the string. + elemental function get_len(self) result(val) + class(my_string_type), intent(in) :: self + integer :: val + val = merge(len(self%raw), 0, allocated(self%raw)) + end function get_len + + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + elemental function get_len_trim(self) result(val) + class(my_string_type), intent(in) :: self + integer :: val + val = merge(len_trim(self%raw), 0, allocated(self%raw)) + end function get_len_trim + + !> Return the character sequence represented by the string. + pure function get_char(self) result(character_string) + class(my_string_type), intent(in) :: self + character(len=:), allocatable :: character_string + if (allocated(self%raw)) then + character_string = self%raw + else + character_string = "" + end if + end function get_char + + !> Return the character sequence represented by the string. + elemental function get_char_pos(self, pos) result(character_string) + class(my_string_type), intent(in) :: self + integer, intent(in) :: pos + character(len=1) :: character_string + if (allocated(self%raw)) then + character_string = self%raw(pos:pos) + else + character_string = "" + end if + end function get_char_pos + + !> Return the character sequence represented by the string. + pure function get_char_range(self, start, last) result(character_string) + class(my_string_type), intent(in) :: self + integer, intent(in) :: start + integer, intent(in) :: last + character(len=last-start+1) :: character_string + if (allocated(self%raw)) then + character_string = self%raw(start:last) + else + character_string = "" + end if + end function get_char_range + +end module string_implementation +``` + + +## Procedures and methods provided + + + +### Assignment of character scalar + +#### Description + +The ABC defines an assignment operations, `=`, to create a string object +from a character scalar. + +#### Syntax + +`lhs = rhs` + +#### Status + +Experimental + +#### Class + +Elemental, deferred subroutine, `assignment(=)`. + + + +### Assignment of string + +#### Description + +The ABC defines an assignment operations, `=`, to create a string class +from a `string_type` instance. + +#### Syntax + +`lhs = rhs` + +#### Status + +Experimental + +#### Class + +Elemental subroutine, `assignment(=)`. + + + +### Len function + +#### Description + +Returns the length of the string object. + +#### Syntax + +`res = [[stdlib_string_class(module):len(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +`string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a default integer scalar value. + + + +### Len\_trim function + +#### Description + +Returns the length of the character sequence without trailing spaces +represented by the string. + +#### Syntax + +`res = [[stdlib_string_class(module):len_trim(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +`string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a default integer scalar value. + + + +### Trim function + +#### Description + +Returns the character sequence hold by the string without trailing spaces +represented by a `string_type`. + +#### Syntax + +`res = [[stdlib_string_class(module):trim(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a scalar `string_type` value. + + + +### Adjustl function + +#### Description + +Left-adjust the character sequence represented by the string. +The length of the character sequence remains unchanged. + +#### Syntax + +`res = [[stdlib_string_class(module):adjustl(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a scalar `string_type` value. + + + +### Adjustr function + +#### Description + +Right-adjust the character sequence represented by the string. +The length of the character sequence remains unchanged. + +#### Syntax + +`res = [[stdlib_string_class(module):adjustr(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a scalar `string_type` value. + + + +### Repeat function + +#### Description + +Repeats the character sequence hold by the string by the number of +specified copies. + +#### Syntax + +`res = [[stdlib_string_class(module):repeat(interface)]] (string, ncopies)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. +- `ncopies`: Integer of default type. This argument is `intent(in)`. + +#### Result value + +The result is a scalar `string_type` value. + + + +### Char function + +#### Description + +Return the character sequence represented by the string. + +#### Syntax + +`res = [[stdlib_string_class(module):char(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a scalar character value. + + + +### Char function (position variant) + +#### Description + +Return the character at a certain position in the string. + +#### Syntax + +`res = [[stdlib_string_class(module):char(interface)]] (string, pos)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. +- `pos`: Integer of default type. This argument is `intent(in)`. + +#### Result value + +The result is a scalar character value. + + + +### Char function (range variant) + +#### Description + +Return a substring from the character sequence of the string. + +#### Syntax + +`res = [[stdlib_string_class(module):char(interface)]] (string, start, last)` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. +- `start`: Integer of default type. This argument is `intent(in)`. +- `last`: Integer of default type. This argument is `intent(in)`. + +#### Result value + +The result is a scalar character value. + + + +### Ichar function + +#### Description + +Character-to-integer conversion function. + +Returns the code for the character in the first character position of the +character sequence in the system's native character set. + +#### Syntax + +`res = [[stdlib_string_class(module):ichar(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a default integer scalar value. + + + +### Iachar function + +#### Description + +Code in ASCII collating sequence. + +Returns the code for the ASCII character in the first character position of +the character sequences represent by the string. + +#### Syntax + +`res = [[stdlib_string_class(module):iachar(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Instance of a `string_type`. This argument is `intent(in)`. + +#### Result value + +The result is a default integer scalar value. + + + +### Index function + +#### Description + +Position of a *substring* within a *string*. + +Returns the position of the start of the leftmost or rightmost occurrence +of string *substring* in *string*, counting from one. If *substring* is not +present in *string*, zero is returned. + +#### Syntax + +`res = [[stdlib_string_class(module):index(interface)]] (string, substring[, back])` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `substring`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `back`: Either absent or a scalar logical value. This argument is `intent(in)`. + +#### Result value + +The result is a default integer scalar value. + + + +### Scan function + +#### Description + +Scans a *string* for the presence any of the characters in a *set* of characters. +If *back* is either absent or *false*, this function returns the position +of the leftmost character of *string* that is in *set*. If *back* is *true*, +the rightmost position is returned. If no character of *set* is found in +*string*, the result is zero. + +#### Syntax + +`res = [[stdlib_string_class(module):scan(interface)]] (string, set[, back])` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `set`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `back`: Either absent or a scalar logical value. This argument is `intent(in)`. + +#### Result value + +The result is a default integer scalar value. + + + +### Verify function + +#### Description + +Verifies that all the characters in *string* belong to the set of characters in *set*. +If *back* is either absent or *false*, this function returns the position +of the leftmost character of *string* that is not in *set*. If *back* is *true*, +the rightmost position is returned. If all characters of *string* are found +in *set*, the result is zero. + +#### Syntax + +`res = [[stdlib_string_class(module):verify(interface)]] (string, set[, back])` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `set`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `back`: Either absent or a scalar logical value. This argument is `intent(in)`. + +#### Result value + +The result is a default integer scalar value. + + + +### Lgt function (lexical greater than) + +#### Description + +Lexically compare the order of two character sequences being greater than. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `lgt` procedure. + +#### Syntax + +`res = [[stdlib_string_class(module):lgt(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Llt function (lexical less than) + +#### Description + +Lexically compare the order of two character sequences being less than. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `llt` procedure. + +#### Syntax + +`res = [[stdlib_string_class(module):llt(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Lge function (lexical greater than or equal) + +#### Description + +Lexically compare the order of two character sequences being greater than +or equal. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `lge` procedure. + +#### Syntax + +`res = [[stdlib_string_class(module):lge(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Lle function (lexical less than or equal) + +#### Description + +Lexically compare the order of two character sequences being less than +or equal. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `lle` procedure. + +#### Syntax + +`res = [[stdlib_string_class(module):lle(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Comparison operator greater + +#### Description + +Compare the order of two character sequences being greater. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `operator(>)` +and `operator(.gt.)`. + +#### Syntax + +`res = lhs > rhs` + +`res = lhs .gt. rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(>)` and `operator(.gt.)`. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Comparison operator less + +#### Description + +Compare the order of two character sequences being less. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `operator(<)` +and `operator(.lt.)`. + +#### Syntax + +`res = lhs < rhs` + +`res = lhs .lt. rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(<)` and `operator(.lt.)`. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Comparison operator greater or equal + +#### Description + +Compare the order of two character sequences being greater or equal. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `operator(>=)` +and `operator(.ge.)`. + +#### Syntax + +`res = lhs >= rhs` + +`res = lhs .ge. rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(>=)` and `operator(.ge.)`. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Comparison operator less or equal + +#### Description + +Compare the order of two character sequences being less or equal. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `operator(<=)` +and `operator(.le.)`. + +#### Syntax + +`res = lhs <= rhs` + +`res = lhs .le. rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(<=)` and `operator(.le.)`. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Comparison operator equal + +#### Description + +Compare two character sequences for equality. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `operator(==)` +and `operator(.eq.)`. + +#### Syntax + +`res = lhs == rhs` + +`res = lhs .eq. rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(==)` and `operator(.eq.)`. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Comparison operator not equal + +#### Description + +Compare two character sequences for inequality. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `operator(/=)` +and `operator(.ne.)`. + +#### Syntax + +`res = lhs /= rhs` + +`res = lhs .ne. rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(/=)` and `operator(.ne.)`. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + + + +### Concatenation operator + +#### Description + +Concatenate two character sequences. + +The left-hand side, the right-hand side or both character sequences can +be represented by a string object. +This defines five procedures overloading the intrinsic `operator(//)`. + +#### Syntax + +`res = lhs // rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(//)`. + +#### Argument + +- `lhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. +- `rhs`: Either scalar character value, string type or string object. + This argument is `intent(in)`. + +#### Result value + +The result is an instance of `string_type`. + + + +### Unformatted write + +#### Description + +Write the character sequence hold by the string to a connected unformatted unit. +The character sequences is represented by an 64 bit signed integer record, +holding the length of the following character record. + +#### Syntax + +`write(unit, iostat=iostat, iomsg=iomsg) string` + +#### Status + +Experimental + +#### Class + +Unformatted user defined derived type output. + +#### Argument + +- `string`: Instance of the string type to read. This argument is `intent(inout)`. +- `unit`: Formatted unit for output. This argument is `intent(in)`. +- `iostat`: Status identifier to indicate success of output operation. + This argument is `intent(out)`. +- `iomsg`: Buffer to return error message in case of failing output operation. + This argument is `intent(inout)`. + + +### Formatted write + +#### Description + +Write the character sequence hold by the string to a connected formatted unit. + +#### Syntax + +`write(unit, fmt, iostat=iostat, iomsg=iomsg) string` + +#### Status + +Experimental + +#### Class + +Formatted user defined derived type output. + +#### Argument + +- `string`: Instance of the string object to read. This argument is `intent(inout)`. +- `unit`: Formatted unit for output. This argument is `intent(in)`. +- `iotype`: Type of formatted data transfer, has the value `"LISTDIRECTED"` for `fmt=*`, + `"NAMELIST"` for namelist output or starts with `"DT"` for derived type output. + This argument is `intent(in)`. +- `v_list`: Rank one array of default integer type containing the edit descriptors for + derived type output. + This argument is `intent(in)`. +- `iostat`: Status identifier to indicate success of output operation. + This argument is `intent(out)`. +- `iomsg`: Buffer to return error message in case of failing output operation. + This argument is `intent(inout)`. + + + +### Unformatted read + +#### Description + +Read a character sequence from a connected unformatted unit into the string. +The character sequences is represented by an 64 bit signed integer record, +holding the length of the following character record. + +On failure the state the read variable is undefined and implementation dependent. + +#### Syntax + +`read(unit, iostat=iostat, iomsg=iomsg) string` + +#### Status + +Experimental + +#### Class + +Unformatted derived type input. + +#### Argument + +- `string`: Instance of the string object to read. This argument is `intent(inout)`. +- `unit`: Formatted unit for input. This argument is `intent(in)`. +- `iostat`: Status identifier to indicate success of input operation. + This argument is `intent(out)`. +- `iomsg`: Buffer to return error message in case of failing input operation. + This argument is `intent(inout)`. + + + +### Formatted read + +#### Description + +Read a character sequence from a connected formatted unit into the string. +List-directed input will retrieve the complete record into the string. + +On failure the state the read variable is undefined and implementation dependent. + +#### Syntax + +`read(unit, fmt, iostat=iostat, iomsg=iomsg) string` + +#### Status + +Experimental + +#### Class + +Formatted derived type input. + +#### Argument + +- `string`: Instance of the string object to read. This argument is `intent(inout)`. +- `unit`: Formatted unit for input. This argument is `intent(in)`. +- `iotype`: Type of formatted data transfer, has the value `"LISTDIRECTED"` for `fmt=*`, + `"NAMELIST"` for namelist input or starts with `"DT"` for derived type input. + This argument is `intent(in)`. +- `v_list`: Rank one array of default integer type containing the edit descriptors for + derived type input. + This argument is `intent(in)`. +- `iostat`: Status identifier to indicate success of input operation. + This argument is `intent(out)`. +- `iomsg`: Buffer to return error message in case of failing input operation. + This argument is `intent(inout)`. diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 85f5c68b6..597fbf780 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -41,6 +41,7 @@ set(SRC stdlib_error.f90 stdlib_kinds.f90 stdlib_logger.f90 + stdlib_string_class.f90 stdlib_string_type.f90 stdlib_system.F90 ${outFiles} diff --git a/src/Makefile.manual b/src/Makefile.manual index 804b04272..05f7e1bed 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_string_class.f90 \ stdlib_string_type.f90 \ $(SRCGEN) @@ -109,3 +110,5 @@ stdlib_stats_var.o: \ stdlib_stats_distribution_PRNG.o: \ stdlib_kinds.o \ stdlib_error.o +stdlib_string_class.o: \ + stdlib_string_type.o diff --git a/src/stdlib_string_class.f90 b/src/stdlib_string_class.f90 new file mode 100644 index 000000000..567d2bfc5 --- /dev/null +++ b/src/stdlib_string_class.f90 @@ -0,0 +1,1749 @@ +! SPDX-Identifier: MIT + +!> Abstract base class (ABC) specification of an extendible string type to hold an +!> arbitrary character sequence. +!> +!> A minimal implementation of the string class has to provide only a setter function +!> in form of an assignment from a fixed length character variable and getter functions +!> for returning the whole string, a character at a certain index and a range of +!> characters within the bounds of the character sequence. +!> +!> The ABC takes care of providing the implementations for all functionality that +!> is intrinsic to character variables in Fortran, therefore an implementation should +!> reexport all overloaded generic interfaces from the ABC. Any string class +!> implementation will be compatibile with the non-extendible [[string_type]] +!> and fixed length and deferred length character variables by those means. +!> +!> Implementations of the string class that are encouraged to overwrite the type +!> bound procedures providing those functionality in the ABC with optimized +!> algorithms suitable for their respective representation of the character sequence. +!> +!> The specification of this module is available [here](../page/specs/stdlib_string_class.html). +module stdlib_string_class + use stdlib_string_type, only : string_type, to_char => char, assignment(=), & + write(formatted), read(formatted), write(unformatted), read(unformatted) + implicit none + private + + public :: string_class + public :: len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl + public :: lgt, lge, llt, lle, char, ichar, iachar + + + !> Returns the length of the character sequence represented by the string. + !> + !> This method is elemental and returns a default integer scalar value. + interface len + module procedure :: len_object + end interface len + + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + !> + !> This method is elemental and returns a default integer scalar value. + interface len_trim + module procedure :: len_trim_object + end interface len_trim + + !> Returns the character sequence hold by the string without trailing spaces. + !> + !> This method is elemental and returns a scalar character value. + interface trim + module procedure :: trim_object + end interface trim + + !> Left-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + !> + !> This method is elemental and returns a scalar character value. + interface adjustl + module procedure :: adjustl_object + end interface adjustl + + !> Right-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + !> + !> This method is elemental and returns a scalar character value. + interface adjustr + module procedure :: adjustr_object + end interface adjustr + + !> Repeats the character sequence hold by the string by the number of + !> specified copies. + !> + !> This method is elemental and returns a scalar character value. + interface repeat + module procedure :: repeat_object + end interface repeat + + !> Return the character sequence represented by the string. + !> + !> This method is elemental and returns a scalar character value. + interface char + module procedure :: char_object + module procedure :: char_object_pos + module procedure :: char_object_range + end interface char + + !> Character-to-integer conversion function. + !> + !> This method is elemental and returns a default integer scalar value. + interface ichar + module procedure :: ichar_object + end interface ichar + + !> Code in ASCII collating sequence. + !> + !> This method is elemental and returns a default integer scalar value. + interface iachar + module procedure :: iachar_object + end interface iachar + + !> Position of a *substring* within a *string*. + !> + !> Returns the position of the start of the leftmost or rightmost occurrence + !> of string *substring* in *string*, counting from one. If *substring* is not + !> present in *string*, zero is returned. + !> + !> This method is elemental and returns a default integer scalar value. + interface index + module procedure :: index_object_object + module procedure :: index_object_string + module procedure :: index_object_char + module procedure :: index_string_object + module procedure :: index_char_object + end interface index + + !> Scan a *string* for the presence of a *set* of characters. Scans a *string* for + !> any of the characters in a *set* of characters. + !> + !> If *back* is either absent or *false*, this function returns the position + !> of the leftmost character of *string* that is in *set*. If *back* is *true*, + !> the rightmost position is returned. If no character of *set* is found in + !> *string*, the result is zero. + !> + !> This method is elemental and returns a default integer scalar value. + interface scan + module procedure :: scan_object_object + module procedure :: scan_object_string + module procedure :: scan_object_char + module procedure :: scan_string_object + module procedure :: scan_char_object + end interface scan + + !> Scan a string for the absence of a set of characters. Verifies that all + !> the characters in string belong to the set of characters in set. + !> + !> If *back* is either absent or *false*, this function returns the position + !> of the leftmost character of *string* that is not in *set*. If *back* is *true*, + !> the rightmost position is returned. If all characters of *string* are found + !> in *set*, the result is zero. + !> + !> This method is elemental and returns a default integer scalar value. + interface verify + module procedure :: verify_object_object + module procedure :: verify_object_string + module procedure :: verify_object_char + module procedure :: verify_string_object + module procedure :: verify_char_object + end interface verify + + !> Lexically compare the order of two character sequences being greater, + !> The left-hand side, the right-hand side or both character sequences can + !> be represented by a string. + !> + !> This method is elemental and returns a default logical scalar value. + interface lgt + module procedure :: lgt_object_object + module procedure :: lgt_object_string + module procedure :: lgt_string_object + module procedure :: lgt_object_char + module procedure :: lgt_char_object + end interface lgt + + !> Lexically compare the order of two character sequences being less, + !> The left-hand side, the right-hand side or both character sequences can + !> be represented by a string. + !> + !> This method is elemental and returns a default logical scalar value. + interface llt + module procedure :: llt_object_object + module procedure :: llt_object_string + module procedure :: llt_string_object + module procedure :: llt_object_char + module procedure :: llt_char_object + end interface llt + + !> Lexically compare the order of two character sequences being greater equal, + !> The left-hand side, the right-hand side or both character sequences can + !> be represented by a string. + !> + !> This method is elemental and returns a default logical scalar value. + interface lge + module procedure :: lge_object_object + module procedure :: lge_object_string + module procedure :: lge_string_object + module procedure :: lge_object_char + module procedure :: lge_char_object + end interface lge + + !> Lexically compare the order of two character sequences being less equal, + !> The left-hand side, the right-hand side or both character sequences can + !> be represented by a string. + !> + !> This method is elemental and returns a default logical scalar value. + interface lle + module procedure :: lle_object_object + module procedure :: lle_object_string + module procedure :: lle_string_object + module procedure :: lle_object_char + module procedure :: lle_char_object + end interface lle + + + !> Abstract base class for string objects + type, abstract :: string_class + contains + private + + !> Assign a character sequence to a string object. + generic, public :: assignment(=) => assign_object_char + ! BUG: Intel 2021 requires deferred bindings to be public + procedure(assign_object_char_interface), public, deferred :: assign_object_char + + !> Assign a string type to a string object. + generic, public :: assignment(=) => assign_object_string + procedure :: assign_object_string + + !> Assign a string type to a string object. + generic, public :: assignment(=) => assign_object_object + procedure :: assign_object_object + + !> Returns the length of the character sequence represented by the string. + ! BUG: Intel 2021 requires deferred bindings to be public + procedure(get_int_interface), public, deferred :: get_len + + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + ! BUG: Intel 2021 requires deferred bindings to be public + procedure(get_int_interface), public, deferred :: get_len_trim + + !> Character-to-integer conversion function. + procedure :: get_ichar + + !> Code in ASCII collating sequence. + procedure :: get_iachar + + !> Return the character sequence represented by the string. + ! BUG: Intel 2021 requires deferred bindings to be public + procedure(get_char_interface), public, deferred :: get_char + + !> Return the character sequence represented by the string. + ! BUG: Intel 2021 requires deferred bindings to be public + procedure(get_char_pos_interface), public, deferred :: get_char_pos + + !> Return the character sequence represented by the string. + ! BUG: Intel 2021 requires deferred bindings to be public + procedure(get_char_range_interface), public, deferred :: get_char_range + + !> Left-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + procedure :: get_trim + + !> Left-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + procedure :: get_adjustl + + !> Right-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + procedure :: get_adjustr + + !> Repeats the character sequence hold by the string by the number of + !> specified copies. + procedure :: get_repeat + + !> Scan a *string* for the presence of a *set* of characters. Scans a *string* for + !> any of the characters in a *set* of characters. + !> + !> If *back* is either absent or *false*, this function returns the position + !> of the leftmost character of *string* that is in *set*. If *back* is *true*, + !> the rightmost position is returned. If no character of *set* is found in + !> *string*, the result is zero. + !> + !> This method is elemental and returns a default integer scalar value. + generic :: get_scan => get_scan_object, get_scan_string, get_scan_char + !> Implementation of scanning against a set provided as string object + procedure :: get_scan_object + !> Implementation of scanning against a set provided as string type + procedure :: get_scan_string + !> Implementation of scanning against a set provided as character scalar + procedure :: get_scan_char + + !> Scan a string for the absence of a set of characters. Verifies that all + !> the characters in string belong to the set of characters in set. + !> + !> If *back* is either absent or *false*, this function returns the position + !> of the leftmost character of *string* that is not in *set*. If *back* is *true*, + !> the rightmost position is returned. If all characters of *string* are found + !> in *set*, the result is zero. + !> + !> This method is elemental and returns a default integer scalar value. + generic :: get_verify => get_verify_object, get_verify_string, get_verify_char + !> Implementation of verifying against a set provided as string object + procedure :: get_verify_object + !> Implementation of verifying against a set provided as string type + procedure :: get_verify_string + !> Implementation of verifying against a set provided as character scalar + procedure :: get_verify_char + + !> Position of a *substring* within a *string*. + !> + !> Returns the position of the start of the leftmost or rightmost occurrence + !> of string *substring* in *string*, counting from one. If *substring* is not + !> present in *string*, zero is returned. + !> + !> This method is elemental and returns a default integer scalar value. + generic :: get_index => get_index_object, get_index_string, get_index_char + !> Implementation of finding a substring provided as string object + procedure :: get_index_object + !> Implementation of finding a substring provided as string type + procedure :: get_index_string + !> Implementation of finding a substring provided as character value + procedure :: get_index_char + + !> Lexically compare two character sequences for being greater. + generic :: is_lgt => is_lgt_object, is_lgt_string, is_lgt_char + !> Implementation of lexical comparison with RHS provided as string object + procedure, pass(lhs) :: is_lgt_object + !> Implementation of lexical comparison with RHS provided as string type + procedure, pass(lhs) :: is_lgt_string + !> Implementation of lexical comparison with RHS provided as character value + procedure, pass(lhs) :: is_lgt_char + + !> Lexically compare two character sequences for being less than. + generic :: is_llt => is_llt_object, is_llt_string, is_llt_char + !> Implementation of lexical comparison with RHS provided as string object + procedure, pass(lhs) :: is_llt_object + !> Implementation of lexical comparison with RHS provided as string type + procedure, pass(lhs) :: is_llt_string + !> Implementation of lexical comparison with RHS provided as character value + procedure, pass(lhs) :: is_llt_char + + !> Lexically compare two character sequences for being greater than or equal. + generic :: is_lge => is_lge_object, is_lge_string, is_lge_char + !> Implementation of lexical comparison with RHS provided as string object + procedure, pass(lhs) :: is_lge_object + !> Implementation of lexical comparison with RHS provided as string type + procedure, pass(lhs) :: is_lge_string + !> Implementation of lexical comparison with RHS provided as character value + procedure, pass(lhs) :: is_lge_char + + !> Lexically compare two character sequences for being less than or equal. + generic :: is_lle => is_lle_object, is_lle_string, is_lle_char + !> Implementation of lexical comparison with RHS provided as string object + procedure, pass(lhs) :: is_lle_object + !> Implementation of lexical comparison with RHS provided as string type + procedure, pass(lhs) :: is_lle_string + !> Implementation of lexical comparison with RHS provided as character value + procedure, pass(lhs) :: is_lle_char + + !> Compare two character sequences for being greater. + generic, public :: operator(>) => gt_object_object, gt_object_string, & + gt_string_object, gt_object_char, gt_char_object + procedure, pass(lhs) :: gt_object_object + procedure, pass(lhs) :: gt_object_string + procedure, pass(rhs) :: gt_string_object + procedure, pass(lhs) :: gt_object_char + procedure, pass(rhs) :: gt_char_object + + !> Compare two character sequences for being less. + generic, public :: operator(<) => lt_object_object, lt_object_string, & + lt_string_object, lt_object_char, lt_char_object + procedure, pass(lhs) :: lt_object_object + procedure, pass(lhs) :: lt_object_string + procedure, pass(rhs) :: lt_string_object + procedure, pass(lhs) :: lt_object_char + procedure, pass(rhs) :: lt_char_object + + !> Compare two character sequences for being greater or equal. + generic, public :: operator(>=) => ge_object_object, ge_object_string, & + ge_string_object, ge_object_char, ge_char_object + procedure, pass(lhs) :: ge_object_object + procedure, pass(lhs) :: ge_object_string + procedure, pass(rhs) :: ge_string_object + procedure, pass(lhs) :: ge_object_char + procedure, pass(rhs) :: ge_char_object + + !> Compare two character sequences for being less or equal. + generic, public :: operator(<=) => le_object_object, le_object_string, & + le_string_object, le_object_char, le_char_object + procedure, pass(lhs) :: le_object_object + procedure, pass(lhs) :: le_object_string + procedure, pass(rhs) :: le_string_object + procedure, pass(lhs) :: le_object_char + procedure, pass(rhs) :: le_char_object + + !> Compare two character sequences for equality. + generic, public :: operator(==) => eq_object_object, eq_object_string, & + eq_string_object, eq_object_char, eq_char_object + procedure, pass(lhs) :: eq_object_object + procedure, pass(lhs) :: eq_object_string + procedure, pass(rhs) :: eq_string_object + procedure, pass(lhs) :: eq_object_char + procedure, pass(rhs) :: eq_char_object + + !> Compare two character sequences for inequality. + generic, public :: operator(/=) => ne_object_object, ne_object_string, & + ne_string_object, ne_object_char, ne_char_object + procedure, pass(lhs) :: ne_object_object + procedure, pass(lhs) :: ne_object_string + procedure, pass(rhs) :: ne_string_object + procedure, pass(lhs) :: ne_object_char + procedure, pass(rhs) :: ne_char_object + + !> Compare two character sequences for inequality. + generic, public :: operator(//) => concat_object_object, concat_object_string, & + concat_string_object, concat_object_char, concat_char_object + procedure, pass(lhs) :: concat_object_object + procedure, pass(lhs) :: concat_object_string + procedure, pass(rhs) :: concat_string_object + procedure, pass(lhs) :: concat_object_char + procedure, pass(rhs) :: concat_char_object + + !> Write the character sequence hold by the string to a connected unformatted + !> unit. + generic, public :: write(unformatted) => write_unformatted + procedure :: write_unformatted + + !> Write the character sequence hold by the string to a connected formatted + !> unit. + generic, public :: write(formatted) => write_formatted + procedure :: write_formatted + + !> Read a character sequence from a connected unformatted unit into the string. + generic, public :: read(unformatted) => read_unformatted + procedure :: read_unformatted + + !> Read a character sequence from a connected formatted unit into the string. + generic, public :: read(formatted) => read_formatted + procedure :: read_formatted + + end type string_class + + + abstract interface + !> Assign a character sequence to a string object. + elemental subroutine assign_object_char_interface(lhs, rhs) + import :: string_class + implicit none + class(string_class), intent(inout) :: lhs + character(len=*), intent(in) :: rhs + end subroutine assign_object_char_interface + + !> Return a integer value representing a property of the character sequence, like + !> - the length of the character sequence + !> - the character-to-integer conversion + elemental function get_int_interface(self) result(val) + import :: string_class + implicit none + class(string_class), intent(in) :: self + integer :: val + end function get_int_interface + + + !> Return the character sequence represented by the string. + pure function get_char_interface(self) result(character_string) + import :: string_class + implicit none + class(string_class), intent(in) :: self + character(len=:), allocatable :: character_string + end function get_char_interface + + !> Return the character sequence represented by the string. + elemental function get_char_pos_interface(self, pos) result(character_string) + import :: string_class + implicit none + class(string_class), intent(in) :: self + integer, intent(in) :: pos + character(len=1) :: character_string + end function get_char_pos_interface + + !> Return the character sequence represented by the string. + pure function get_char_range_interface(self, start, last) result(character_string) + import :: string_class + implicit none + class(string_class), intent(in) :: self + integer, intent(in) :: start + integer, intent(in) :: last + character(len=last-start+1) :: character_string + end function get_char_range_interface + + + !> Logical operator interface for a string class object. + !> In this version both character sequences are by a string. + elemental function op_object_object_interface(lhs, rhs) result(res) + import :: string_class + implicit none + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: res + end function op_object_object_interface + + !> Logical operator interface for a string class object. + !> In this version the left-hand side character sequences is by a string. + elemental function op_object_char_interface(lhs, rhs) result(res) + import :: string_class + implicit none + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: res + end function op_object_char_interface + + !> Logical operator interface for a string class object. + !> In this version the right-hand side character sequences is by a string. + elemental function op_char_object_interface(lhs, rhs) result(res) + import :: string_class + implicit none + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: res + end function op_char_object_interface + + + !> Concatenate two character sequences. + !> In this version both character sequences are by a string. + elemental function concat_object_object_interface(lhs, rhs) result(string) + import :: string_class, string_type + implicit none + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + type(string_type) :: string + end function concat_object_object_interface + + !> Concatenate two character sequences. + !> In this version the left-hand side character sequences is by a string. + elemental function concat_object_char_interface(lhs, rhs) result(string) + import :: string_class, string_type + implicit none + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + type(string_type) :: string + end function concat_object_char_interface + + !> Concatenate two character sequences. + !> In this version the right-hand side character sequences is by a string. + elemental function concat_char_object_interface(lhs, rhs) result(string) + import :: string_class, string_type + implicit none + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + type(string_type) :: string + end function concat_char_object_interface + end interface + +contains + + !> Assign a string type to a string object. + elemental subroutine assign_object_string(lhs, rhs) + class(string_class), intent(inout) :: lhs + type(string_type), intent(in) :: rhs + lhs = to_char(rhs) + end subroutine assign_object_string + + !> Assign a string object to a string object. + elemental subroutine assign_object_object(lhs, rhs) + class(string_class), intent(inout) :: lhs + class(string_class), intent(in) :: rhs + lhs = rhs%get_char() + end subroutine assign_object_object + + + !> Character-to-integer conversion function. + elemental function get_ichar(self) result(ich) + class(string_class), intent(in) :: self + integer :: ich + ich = ichar(char(self)) + end function get_ichar + + !> Code in ASCII collating sequence. + elemental function get_iachar(self) result(ich) + class(string_class), intent(in) :: self + integer :: ich + ich = iachar(char(self)) + end function get_iachar + + + !> Returns the character sequence hold by the string without trailing spaces. + elemental function get_trim(self) result(trimmed_string) + class(string_class), intent(in) :: self + type(string_type) :: trimmed_string + + trimmed_string = trim(char(self)) + + end function get_trim + + + !> Left-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + elemental function get_adjustl(self) result(adjusted_string) + class(string_class), intent(in) :: self + type(string_type) :: adjusted_string + + adjusted_string = adjustl(char(self)) + + end function get_adjustl + + + !> Right-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + elemental function get_adjustr(self) result(adjusted_string) + class(string_class), intent(in) :: self + type(string_type) :: adjusted_string + + adjusted_string = adjustr(char(self)) + + end function get_adjustr + + + !> Repeats the character sequence hold by the string by the number of + !> specified copies. + elemental function get_repeat(self, ncopies) result(repeated_string) + class(string_class), intent(in) :: self + integer, intent(in) :: ncopies + type(string_type) :: repeated_string + + repeated_string = repeat(char(self), ncopies) + + end function get_repeat + + + !> Position of a sequence of character within a character sequence. + elemental function get_index_object(self, substring, back) result(pos) + class(string_class), intent(in) :: self + class(string_class), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + + pos = index(char(self), char(substring), & + merge(back, .false., present(back))) + + end function get_index_object + + !> Position of a sequence of character within a character sequence. + elemental function get_index_string(self, substring, back) result(pos) + class(string_class), intent(in) :: self + type(string_type), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + + pos = index(char(self), to_char(substring), & + merge(back, .false., present(back))) + + end function get_index_string + + !> Position of a sequence of character within a character sequence. + elemental function get_index_char(self, substring, back) result(pos) + class(string_class), intent(in) :: self + character(len=*), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + + pos = index(char(self), substring, & + merge(back, .false., present(back))) + + end function get_index_char + + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function get_scan_object(self, set, back) result(pos) + class(string_class), intent(in) :: self + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = scan(char(self), char(set), & + merge(back, .false., present(back))) + + end function get_scan_object + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function get_scan_string(self, set, back) result(pos) + class(string_class), intent(in) :: self + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = scan(char(self), to_char(set), & + merge(back, .false., present(back))) + + end function get_scan_string + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function get_scan_char(self, set, back) result(pos) + class(string_class), intent(in) :: self + character(len=*), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = scan(char(self), set, & + merge(back, .false., present(back))) + + end function get_scan_char + + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function get_verify_object(self, set, back) result(pos) + class(string_class), intent(in) :: self + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = verify(char(self), char(set), & + merge(back, .false., present(back))) + + end function get_verify_object + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function get_verify_string(self, set, back) result(pos) + class(string_class), intent(in) :: self + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = verify(char(self), to_char(set), & + merge(back, .false., present(back))) + + end function get_verify_string + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function get_verify_char(self, set, back) result(pos) + class(string_class), intent(in) :: self + character(len=*), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = verify(char(self), set, & + merge(back, .false., present(back))) + + end function get_verify_char + + + !> Lexically compare two character sequences for being greater than. + elemental function is_lgt_object(lhs, rhs) result(is_lgt) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(char(lhs), char(rhs)) + + end function is_lgt_object + + !> Lexically compare two character sequences for being greater than. + elemental function is_lgt_string(lhs, rhs) result(is_lgt) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(char(lhs), to_char(rhs)) + + end function is_lgt_string + + !> Lexically compare two character sequences for being greater than. + elemental function is_lgt_char(lhs, rhs) result(is_lgt) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(char(lhs), rhs) + + end function is_lgt_char + + !> Lexically compare two character sequences for being less than. + elemental function is_llt_object(lhs, rhs) result(is_llt) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(char(lhs), char(rhs)) + + end function is_llt_object + + !> Lexically compare two character sequences for being less than. + elemental function is_llt_string(lhs, rhs) result(is_llt) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(char(lhs), to_char(rhs)) + + end function is_llt_string + + !> Lexically compare two character sequences for being less than. + elemental function is_llt_char(lhs, rhs) result(is_llt) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(char(lhs), rhs) + + end function is_llt_char + + !> Lexically compare two character sequences for being greater than or equal. + elemental function is_lge_object(lhs, rhs) result(is_lge) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(char(lhs), char(rhs)) + + end function is_lge_object + + !> Lexically compare two character sequences for being greater or equal. + elemental function is_lge_string(lhs, rhs) result(is_lge) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(char(lhs), to_char(rhs)) + + end function is_lge_string + + !> Lexically compare two character sequences for being greater than or equal. + elemental function is_lge_char(lhs, rhs) result(is_lge) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(char(lhs), rhs) + + end function is_lge_char + + !> Lexically compare two character sequences for being less than or equal. + elemental function is_lle_object(lhs, rhs) result(is_lle) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(char(lhs), char(rhs)) + + end function is_lle_object + + !> Lexically compare two character sequences for being less than or equal. + elemental function is_lle_string(lhs, rhs) result(is_lle) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(char(lhs), to_char(rhs)) + + end function is_lle_string + + !> Lexically compare two character sequences for being less than or equal. + elemental function is_lle_char(lhs, rhs) result(is_lle) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(char(lhs), rhs) + + end function is_lle_char + + + + !> Compare two character sequences for being greater. + elemental function gt_object_object(lhs, rhs) result(is_gt) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_gt + + is_gt = char(lhs) > char(rhs) + + end function gt_object_object + + !> Compare two character sequences for being greater. + elemental function gt_object_char(lhs, rhs) result(is_gt) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_gt + + is_gt = char(lhs) > rhs + + end function gt_object_char + + !> Compare two character sequences for being greater. + elemental function gt_object_string(lhs, rhs) result(is_gt) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_gt + + is_gt = char(lhs) > to_char(rhs) + + end function gt_object_string + + !> Compare two character sequences for being greater. + elemental function gt_string_object(lhs, rhs) result(is_gt) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_gt + + is_gt = to_char(lhs) > char(rhs) + + end function gt_string_object + + !> Compare two character sequences for being greater. + elemental function gt_char_object(lhs, rhs) result(is_gt) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_gt + + is_gt = lhs > char(rhs) + + end function gt_char_object + + + !> Compare two character sequences for being less. + elemental function lt_object_object(lhs, rhs) result(is_lt) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_object_object + + !> Compare two character sequences for being less. + elemental function lt_object_char(lhs, rhs) result(is_lt) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_object_char + + !> Compare two character sequences for being less. + elemental function lt_object_string(lhs, rhs) result(is_lt) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_object_string + + !> Compare two character sequences for being less. + elemental function lt_string_object(lhs, rhs) result(is_lt) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_string_object + + !> Compare two character sequences for being less. + elemental function lt_char_object(lhs, rhs) result(is_lt) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_char_object + + + !> Compare two character sequences for being greater or equal. + elemental function ge_object_object(lhs, rhs) result(is_ge) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_object_object + + !> Compare two character sequences for being greater or equal. + elemental function ge_object_char(lhs, rhs) result(is_ge) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_object_char + + !> Compare two character sequences for being greater or equal. + elemental function ge_object_string(lhs, rhs) result(is_ge) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_object_string + + !> Compare two character sequences for being greater or equal + elemental function ge_string_object(lhs, rhs) result(is_ge) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_string_object + + !> Compare two character sequences for being greater or equal + elemental function ge_char_object(lhs, rhs) result(is_ge) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_char_object + + + !> Compare two character sequences for being less or equal. + elemental function le_object_object(lhs, rhs) result(is_le) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_object_object + + !> Compare two character sequences for being less or equal. + elemental function le_object_char(lhs, rhs) result(is_le) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_object_char + + !> Compare two character sequences for being less or equal. + elemental function le_object_string(lhs, rhs) result(is_le) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_object_string + + !> Compare two character sequences for being less or equal + elemental function le_string_object(lhs, rhs) result(is_le) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_string_object + + !> Compare two character sequences for being less or equal + elemental function le_char_object(lhs, rhs) result(is_le) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_char_object + + + !> Compare two character sequences for equality. + elemental function eq_object_object(lhs, rhs) result(is_eq) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_eq + + is_eq = .not.(lhs > rhs) + if (is_eq) then + is_eq = .not.(rhs > lhs) + end if + + end function eq_object_object + + !> Compare two character sequences for equality. + elemental function eq_object_char(lhs, rhs) result(is_eq) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_eq + + is_eq = .not.(lhs > rhs) + if (is_eq) then + is_eq = .not.(rhs > lhs) + end if + + end function eq_object_char + + !> Compare two character sequences for equality. + elemental function eq_object_string(lhs, rhs) result(is_eq) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_eq + + is_eq = .not.(lhs > rhs) + if (is_eq) then + is_eq = .not.(rhs > lhs) + end if + + end function eq_object_string + + !> Compare two character sequences for equality. + elemental function eq_string_object(lhs, rhs) result(is_eq) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_eq + + is_eq = .not.(lhs > rhs) + if (is_eq) then + is_eq = .not.(rhs > lhs) + end if + + end function eq_string_object + + !> Compare two character sequences for equality. + elemental function eq_char_object(lhs, rhs) result(is_eq) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_eq + + is_eq = .not.(lhs > rhs) + if (is_eq) then + is_eq = .not.(rhs > lhs) + end if + + end function eq_char_object + + + !> Compare two character sequences for inequality. + elemental function ne_object_object(lhs, rhs) result(is_ne) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_ne + + is_ne = lhs > rhs + if (.not.is_ne) then + is_ne = rhs > lhs + end if + + end function ne_object_object + + !> Compare two character sequences for inequality. + elemental function ne_object_char(lhs, rhs) result(is_ne) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_ne + + is_ne = lhs > rhs + if (.not.is_ne) then + is_ne = rhs > lhs + end if + + end function ne_object_char + + !> Compare two character sequences for inequality. + elemental function ne_object_string(lhs, rhs) result(is_ne) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_ne + + is_ne = lhs > rhs + if (.not.is_ne) then + is_ne = rhs > lhs + end if + + end function ne_object_string + + !> Compare two character sequences for inequality. + elemental function ne_string_object(lhs, rhs) result(is_ne) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_ne + + is_ne = lhs > rhs + if (.not.is_ne) then + is_ne = rhs > lhs + end if + + end function ne_string_object + + !> Compare two character sequences for inequality. + elemental function ne_char_object(lhs, rhs) result(is_ne) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_ne + + is_ne = lhs > rhs + if (.not.is_ne) then + is_ne = rhs > lhs + end if + + end function ne_char_object + + + !> Compare two character sequences for being greater. + elemental function concat_object_object(lhs, rhs) result(string) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + type(string_type) :: string + + string = char(lhs) // char(rhs) + + end function concat_object_object + + !> Compare two character sequences for being greater. + elemental function concat_object_char(lhs, rhs) result(string) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + type(string_type) :: string + + string = char(lhs) // rhs + + end function concat_object_char + + !> Compare two character sequences for being greater. + elemental function concat_object_string(lhs, rhs) result(string) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + type(string_type) :: string + + string = char(lhs) // to_char(rhs) + + end function concat_object_string + + !> Compare two character sequences for being greater. + elemental function concat_string_object(lhs, rhs) result(string) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + type(string_type) :: string + + string = to_char(lhs) // char(rhs) + + end function concat_string_object + + !> Compare two character sequences for being greater. + elemental function concat_char_object(lhs, rhs) result(string) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + type(string_type) :: string + + string = lhs // char(rhs) + + end function concat_char_object + + + !> Returns the length of the character sequence represented by the string. + elemental function len_object(string) result(length) + class(string_class), intent(in) :: string + integer :: length + length = string%get_len() + end function len_object + + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + elemental function len_trim_object(string) result(length) + class(string_class), intent(in) :: string + integer :: length + length = string%get_len_trim() + end function len_trim_object + + !> Character-to-integer conversion function. + elemental function ichar_object(string) result(ich) + class(string_class), intent(in) :: string + integer :: ich + ich = string%get_ichar() + end function ichar_object + + !> Code in ASCII collating sequence. + elemental function iachar_object(string) result(ich) + class(string_class), intent(in) :: string + integer :: ich + ich = string%get_iachar() + end function iachar_object + + !> Return the character sequence represented by the string. + pure function char_object(string) result(character_string) + class(string_class), intent(in) :: string + character(len=:), allocatable :: character_string + character_string = string%get_char() + end function char_object + + !> Return the character sequence represented by the string. + elemental function char_object_pos(string, pos) result(character_string) + class(string_class), intent(in) :: string + integer, intent(in) :: pos + character(len=1) :: character_string + character_string = string%get_char_pos(pos) + end function char_object_pos + + !> Return the character sequence represented by the string. + pure function char_object_range(string, start, last) result(character_string) + class(string_class), intent(in) :: string + integer, intent(in) :: start + integer, intent(in) :: last + character(len=last-start+1) :: character_string + character_string = string%get_char_range(start, last) + end function char_object_range + + !> Returns the character sequence hold by the string without trailing spaces. + elemental function trim_object(string) result(trimmed_string) + class(string_class), intent(in) :: string + type(string_type) :: trimmed_string + trimmed_string = string%get_trim() + end function trim_object + + + !> Left-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + elemental function adjustl_object(string) result(adjusted_string) + class(string_class), intent(in) :: string + type(string_type) :: adjusted_string + adjusted_string = string%get_adjustl() + end function adjustl_object + + + !> Right-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + elemental function adjustr_object(string) result(adjusted_string) + class(string_class), intent(in) :: string + type(string_type) :: adjusted_string + adjusted_string = string%get_adjustr() + end function adjustr_object + + + !> Repeats the character sequence hold by the string by the number of + !> specified copies. + elemental function repeat_object(string, ncopies) result(repeated_string) + class(string_class), intent(in) :: string + integer, intent(in) :: ncopies + type(string_type) :: repeated_string + repeated_string = string%get_repeat(ncopies) + end function repeat_object + + + !> Position of a sequence of character within a character sequence. + elemental function index_object_object(string, substring, back) result(pos) + class(string_class), intent(in) :: string + class(string_class), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + pos = string%get_index(substring, back) + end function index_object_object + + !> Position of a sequence of character within a character sequence. + elemental function index_object_string(string, substring, back) result(pos) + class(string_class), intent(in) :: string + type(string_type), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + pos = string%get_index(substring, back) + end function index_object_string + + !> Position of a sequence of character within a character sequence. + elemental function index_object_char(string, substring, back) result(pos) + class(string_class), intent(in) :: string + character(len=*), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + pos = string%get_index(substring, back) + end function index_object_char + + !> Position of a sequence of character within a character sequence. + elemental function index_string_object(string, substring, back) result(pos) + type(string_type), intent(in) :: string + class(string_class), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + pos = index(to_char(string), char(substring), & + merge(back, .false., present(back))) + end function index_string_object + + !> Position of a sequence of character within a character sequence. + elemental function index_char_object(string, substring, back) result(pos) + character(len=*), intent(in) :: string + class(string_class), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + pos = index(string, char(substring), & + merge(back, .false., present(back))) + end function index_char_object + + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function scan_object_object(string, set, back) result(pos) + class(string_class), intent(in) :: string + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = string%get_scan(set, back) + end function scan_object_object + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function scan_object_string(string, set, back) result(pos) + class(string_class), intent(in) :: string + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = string%get_scan(set, back) + end function scan_object_string + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function scan_object_char(string, set, back) result(pos) + class(string_class), intent(in) :: string + character(len=*), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = string%get_scan(set, back) + end function scan_object_char + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function scan_string_object(string, set, back) result(pos) + type(string_type), intent(in) :: string + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = scan(to_char(string), char(set), & + merge(back, .false., present(back))) + end function scan_string_object + + !> Scan a character sequence for any of the characters in a set of characters. + elemental function scan_char_object(string, set, back) result(pos) + character(len=*), intent(in) :: string + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = scan(string, char(set), & + merge(back, .false., present(back))) + end function scan_char_object + + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function verify_object_object(string, set, back) result(pos) + class(string_class), intent(in) :: string + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = string%get_verify(set, back) + end function verify_object_object + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function verify_object_string(string, set, back) result(pos) + class(string_class), intent(in) :: string + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = string%get_verify(set, back) + end function verify_object_string + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function verify_object_char(string, set, back) result(pos) + class(string_class), intent(in) :: string + character(len=*), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = string%get_verify(set, back) + end function verify_object_char + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function verify_string_object(string, set, back) result(pos) + type(string_type), intent(in) :: string + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = verify(to_char(string), char(set), & + merge(back, .false., present(back))) + end function verify_string_object + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. + elemental function verify_char_object(string, set, back) result(pos) + character(len=*), intent(in) :: string + class(string_class), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + pos = verify(string, char(set), & + merge(back, .false., present(back))) + end function verify_char_object + + + !> Lexically compare two character sequences for being greater. + elemental function lgt_object_object(lhs, rhs) result(is_lgt) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lhs%is_lgt(rhs) + + end function lgt_object_object + + !> Lexically compare two character sequences for being greater. + elemental function lgt_object_string(lhs, rhs) result(is_lgt) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lhs%is_lgt(rhs) + + end function lgt_object_string + + !> Lexically compare two character sequences for being greater. + elemental function lgt_string_object(lhs, rhs) result(is_lgt) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(to_char(lhs), char(rhs)) + + end function lgt_string_object + + !> Lexically compare two character sequences for being greater. + elemental function lgt_object_char(lhs, rhs) result(is_lgt) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lhs%is_lgt(rhs) + + end function lgt_object_char + + !> Lexically compare two character sequences for being greater. + elemental function lgt_char_object(lhs, rhs) result(is_lgt) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(lhs, char(rhs)) + + end function lgt_char_object + + !> Lexically compare two character sequences for being less. + elemental function llt_object_object(lhs, rhs) result(is_llt) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_llt + + is_llt = lhs%is_llt(rhs) + + end function llt_object_object + + !> Lexically compare two character sequences for being less. + elemental function llt_object_string(lhs, rhs) result(is_llt) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_llt + + is_llt = lhs%is_llt(rhs) + + end function llt_object_string + + !> Lexically compare two character sequences for being less. + elemental function llt_string_object(lhs, rhs) result(is_llt) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(to_char(lhs), char(rhs)) + + end function llt_string_object + + !> Lexically compare two character sequences for being less. + elemental function llt_object_char(lhs, rhs) result(is_llt) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_llt + + is_llt = lhs%is_llt(rhs) + + end function llt_object_char + + !> Lexically compare two character sequences for being less. + elemental function llt_char_object(lhs, rhs) result(is_llt) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(lhs, char(rhs)) + + end function llt_char_object + + !> Lexically compare two character sequences for being greater or equal. + elemental function lge_object_object(lhs, rhs) result(is_lge) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lge + + is_lge = lhs%is_lge(rhs) + + end function lge_object_object + + !> Lexically compare two character sequences for being greater or equal. + elemental function lge_object_string(lhs, rhs) result(is_lge) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lge + + is_lge = lhs%is_lge(rhs) + + end function lge_object_string + + !> Lexically compare two character sequences for being greater or equal. + elemental function lge_string_object(lhs, rhs) result(is_lge) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(to_char(lhs), char(rhs)) + + end function lge_string_object + + !> Lexically compare two character sequences for being greater or equal. + elemental function lge_object_char(lhs, rhs) result(is_lge) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lge + + is_lge = lhs%is_lge(rhs) + + end function lge_object_char + + !> Lexically compare two character sequences for being greater or equal. + elemental function lge_char_object(lhs, rhs) result(is_lge) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(lhs, char(rhs)) + + end function lge_char_object + + !> Lexically compare two character sequences for being less or equal. + elemental function lle_object_object(lhs, rhs) result(is_lle) + class(string_class), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lle + + is_lle = lhs%is_lle(rhs) + + end function lle_object_object + + !> Lexically compare two character sequences for being less or equal. + elemental function lle_object_string(lhs, rhs) result(is_lle) + class(string_class), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lle + + is_lle = lhs%is_lle(rhs) + + end function lle_object_string + + !> Lexically compare two character sequences for being less or equal + elemental function lle_string_object(lhs, rhs) result(is_lle) + type(string_type), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(to_char(lhs), char(rhs)) + + end function lle_string_object + + !> Lexically compare two character sequences for being less or equal. + elemental function lle_object_char(lhs, rhs) result(is_lle) + class(string_class), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lle + + is_lle = lhs%is_lle(rhs) + + end function lle_object_char + + !> Lexically compare two character sequences for being less or equal + elemental function lle_char_object(lhs, rhs) result(is_lle) + character(len=*), intent(in) :: lhs + class(string_class), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(lhs, char(rhs)) + + end function lle_char_object + + + !> Write the character sequence hold by the string to a connected unformatted + !> unit. + subroutine write_unformatted(self, unit, iostat, iomsg) + class(string_class), intent(in) :: self + integer, intent(in) :: unit + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + type(string_type) :: string + string = char(self) + write(unit, iostat=iostat, iomsg=iomsg) string + end subroutine write_unformatted + + !> Write the character sequence hold by the string to a connected formatted + !> unit. + subroutine write_formatted(self, unit, iotype, v_list, iostat, iomsg) + class(string_class), intent(in) :: self + integer, intent(in) :: unit + character(len=*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + type(string_type) :: string + call unused_dummy_argument(iotype) + call unused_dummy_argument(v_list) + string = char(self) + write(unit, *, iostat=iostat, iomsg=iomsg) string + end subroutine write_formatted + + + !> Read a character sequence from a connected unformatted unit into the string. + subroutine read_unformatted(self, unit, iostat, iomsg) + class(string_class), intent(inout) :: self + integer, intent(in) :: unit + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + type(string_type) :: string + read(unit, iostat=iostat, iomsg=iomsg) string + self = to_char(string) + end subroutine read_unformatted + + !> Read a character sequence from a connected formatted unit into the string. + subroutine read_formatted(self, unit, iotype, v_list, iostat, iomsg) + class(string_class), intent(inout) :: self + integer, intent(in) :: unit + character(len=*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + type(string_type) :: string + call unused_dummy_argument(iotype) + call unused_dummy_argument(v_list) + read(unit, *, iostat=iostat, iomsg=iomsg) string + self = to_char(string) + end subroutine read_formatted + + + !> Do nothing but mark an unused dummy argument as such to acknowledge compile + !> time warning like: + !> + !> Warning: Unused dummy argument ‘dummy’ at (1) [-Wunused-dummy-argument] + !> + !> We deeply trust in the compiler to inline and optimize this piece of code away. + elemental subroutine unused_dummy_argument(dummy) + class(*), intent(in) :: dummy + associate(dummy => dummy); end associate + end subroutine unused_dummy_argument + +end module stdlib_string_class diff --git a/src/tests/string/CMakeLists.txt b/src/tests/string/CMakeLists.txt index bda103c7b..6b9cfc06d 100644 --- a/src/tests/string/CMakeLists.txt +++ b/src/tests/string/CMakeLists.txt @@ -2,4 +2,4 @@ ADDTEST(string_assignment) ADDTEST(string_operator) ADDTEST(string_intrinsic) ADDTEST(string_derivedtype_io) - +ADDTEST(string_class) diff --git a/src/tests/string/Makefile.manual b/src/tests/string/Makefile.manual index e3789447d..561cd91db 100644 --- a/src/tests/string/Makefile.manual +++ b/src/tests/string/Makefile.manual @@ -1,4 +1,5 @@ PROGS_SRC = test_string_assignment.f90 \ + test_string_class.f90 \ test_string_derivedtype_io.f90 \ test_string_intrinsic.f90 \ test_string_operator.f90 diff --git a/src/tests/string/test_string_class.f90 b/src/tests/string/test_string_class.f90 new file mode 100644 index 000000000..c461ce510 --- /dev/null +++ b/src/tests/string/test_string_class.f90 @@ -0,0 +1,774 @@ +!> Minimal implementation of a string based on the stdlib string abstract base class +module string_implementation + use stdlib_string_class, only : string_class, & + len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl, & + lgt, lge, llt, lle, char, ichar, iachar + implicit none + private + + public :: my_string_type + public :: len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl + public :: lgt, lge, llt, lle, char, ichar, iachar + + !> Definition of a string class implementation + type, extends(string_class) :: my_string_type + private + character(len=:), allocatable :: raw + contains + !> Assign a character sequence to a string object. + procedure :: assign_object_char + !> Returns the length of the character sequence represented by the string. + procedure :: get_len + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + procedure :: get_len_trim + !> Return the character sequence represented by the string. + procedure :: get_char + !> Return the character sequence represented by the string. + procedure :: get_char_pos + !> Return the character sequence represented by the string. + procedure :: get_char_range + end type my_string_type + + !> Constructor for string class implementation + interface my_string_type + module procedure :: new_string + end interface my_string_type + +contains + + !> Constructor for new string instances from a scalar character value. + elemental function new_string(string) result(new) + character(len=*), intent(in), optional :: string + type(my_string_type) :: new + if (present(string)) then + new%raw = string + end if + end function new_string + + !> Assign a character sequence to a string object. + elemental subroutine assign_object_char(lhs, rhs) + class(my_string_type), intent(inout) :: lhs + character(len=*), intent(in) :: rhs + lhs%raw = rhs + end subroutine assign_object_char + + !> Returns the length of the character sequence represented by the string. + elemental function get_len(self) result(val) + class(my_string_type), intent(in) :: self + integer :: val + val = merge(len(self%raw), 0, allocated(self%raw)) + end function get_len + + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + elemental function get_len_trim(self) result(val) + class(my_string_type), intent(in) :: self + integer :: val + val = merge(len_trim(self%raw), 0, allocated(self%raw)) + end function get_len_trim + + !> Return the character sequence represented by the string. + pure function get_char(self) result(character_string) + class(my_string_type), intent(in) :: self + character(len=:), allocatable :: character_string + if (allocated(self%raw)) then + character_string = self%raw + else + character_string = "" + end if + end function get_char + + !> Return the character sequence represented by the string. + elemental function get_char_pos(self, pos) result(character_string) + class(my_string_type), intent(in) :: self + integer, intent(in) :: pos + character(len=1) :: character_string + if (allocated(self%raw)) then + character_string = self%raw(pos:pos) + else + character_string = "" + end if + end function get_char_pos + + !> Return the character sequence represented by the string. + pure function get_char_range(self, start, last) result(character_string) + class(my_string_type), intent(in) :: self + integer, intent(in) :: start + integer, intent(in) :: last + character(len=last-start+1) :: character_string + if (allocated(self%raw)) then + character_string = self%raw(start:last) + else + character_string = "" + end if + end function get_char_range + +end module string_implementation + +! SPDX-Identifer: MIT +module test_string_class + use stdlib_error, only : check + use stdlib_string_type + use string_implementation + implicit none + + abstract interface + !> Actual tester working on a string type and a fixed length character + !> representing the same character sequence + subroutine check1_interface(str1, chr1) + import :: my_string_type + type(my_string_type), intent(in) :: str1 + character(len=*), intent(in) :: chr1 + end subroutine check1_interface + + !> Actual tester working on two pairs of string type and fixed length + !> character representing the same character sequences + subroutine check2_interface(str1, chr1, str2, chr2) + import :: my_string_type + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + end subroutine check2_interface + end interface + +contains + + !> Generate then checker both for the string type created from the character + !> sequence by the contructor and the assignment operation + subroutine check1(chr1, checker) + character(len=*), intent(in) :: chr1 + procedure(check1_interface) :: checker + call constructor_check1(chr1, checker) + call assignment_check1(chr1, checker) + end subroutine check1 + + !> Run the actual checker with a string type generated by the custom constructor + subroutine constructor_check1(chr1, checker) + character(len=*), intent(in) :: chr1 + procedure(check1_interface) :: checker + call checker(my_string_type(chr1), chr1) + end subroutine constructor_check1 + + !> Run the actual checker with a string type generated by assignment + subroutine assignment_check1(chr1, checker) + character(len=*), intent(in) :: chr1 + type(my_string_type) :: str1 + procedure(check1_interface) :: checker + str1 = chr1 + call checker(str1, chr1) + end subroutine assignment_check1 + + !> Generate then checker both for the string type created from the character + !> sequence by the contructor and the assignment operation as well as the + !> mixed assigment and constructor setup + subroutine check2(chr1, chr2, checker) + character(len=*), intent(in) :: chr1, chr2 + procedure(check2_interface) :: checker + call constructor_check2(chr1, chr2, checker) + call assignment_check2(chr1, chr2, checker) + call mixed_check2(chr1, chr2, checker) + end subroutine check2 + + !> Run the actual checker with both string types generated by the custom constructor + subroutine constructor_check2(chr1, chr2, checker) + character(len=*), intent(in) :: chr1, chr2 + procedure(check2_interface) :: checker + call checker(my_string_type(chr1), chr1, my_string_type(chr2), chr2) + end subroutine constructor_check2 + + !> Run the actual checker with one string type generated by the custom constructor + !> and the other by assignment + subroutine mixed_check2(chr1, chr2, checker) + character(len=*), intent(in) :: chr1, chr2 + type(my_string_type) :: str1, str2 + procedure(check2_interface) :: checker + str1 = chr1 + str2 = chr2 + call checker(str1, chr1, my_string_type(chr2), chr2) + call checker(my_string_type(chr1), chr1, str2, chr2) + end subroutine mixed_check2 + + !> Run the actual checker with both string types generated by assignment + subroutine assignment_check2(chr1, chr2, checker) + character(len=*), intent(in) :: chr1, chr2 + type(my_string_type) :: str1, str2 + procedure(check2_interface) :: checker + str1 = chr1 + str2 = chr2 + call checker(str1, chr1, str2, chr2) + end subroutine assignment_check2 + + !> Generator for checking the lexical comparison + subroutine gen_lgt(str1, chr1, str2, chr2) + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + call check(lgt(str1, str2) .eqv. lgt(chr1, chr2)) + call check(lgt(str1, chr2) .eqv. lgt(chr1, chr2)) + call check(lgt(chr1, str2) .eqv. lgt(chr1, chr2)) + end subroutine gen_lgt + + subroutine test_lgt + type(my_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.) + + call check2("bcd", "abc", gen_lgt) + call check2("bcd", "bcd", gen_lgt) + call check2("bcd", "cde", gen_lgt) + end subroutine test_lgt + + !> Generator for checking the lexical comparison + subroutine gen_llt(str1, chr1, str2, chr2) + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + call check(llt(str1, str2) .eqv. llt(chr1, chr2)) + call check(llt(str1, chr2) .eqv. llt(chr1, chr2)) + call check(llt(chr1, str2) .eqv. llt(chr1, chr2)) + end subroutine gen_llt + + subroutine test_llt + type(my_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.) + + call check2("bcd", "abc", gen_llt) + call check2("bcd", "bcd", gen_llt) + call check2("bcd", "cde", gen_llt) + end subroutine test_llt + + !> Generator for checking the lexical comparison + subroutine gen_lge(str1, chr1, str2, chr2) + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + call check(lge(str1, str2) .eqv. lge(chr1, chr2)) + call check(lge(str1, chr2) .eqv. lge(chr1, chr2)) + call check(lge(chr1, str2) .eqv. lge(chr1, chr2)) + end subroutine gen_lge + + subroutine test_lge + type(my_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.) + + call check2("bcd", "abc", gen_lge) + call check2("bcd", "bcd", gen_lge) + call check2("bcd", "cde", gen_lge) + end subroutine test_lge + + !> Generator for checking the lexical comparison + subroutine gen_lle(str1, chr1, str2, chr2) + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + call check(lle(str1, str2) .eqv. lle(chr1, chr2)) + call check(lle(str1, chr2) .eqv. lle(chr1, chr2)) + call check(lle(chr1, str2) .eqv. lle(chr1, chr2)) + end subroutine gen_lle + + subroutine test_lle + type(my_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.) + + call check2("bcd", "abc", gen_lle) + call check2("bcd", "bcd", gen_lle) + call check2("bcd", "cde", gen_lle) + end subroutine test_lle + + !> Generator for checking the trimming of whitespace + subroutine gen_trim(str1, chr1) + type(my_string_type), intent(in) :: str1 + character(len=*), intent(in) :: chr1 + call check(len(trim(str1)) == len(trim(chr1))) + end subroutine gen_trim + + subroutine test_trim + type(my_string_type) :: string, trimmed_str + + string = "Whitespace " + trimmed_str = trim(string) + call check(len(trimmed_str) == 10) + + call check1(" Whitespace ", gen_trim) + call check1(" W h i t e s p a ce ", gen_trim) + call check1("SPACE SPACE", gen_trim) + call check1(" ", gen_trim) + end subroutine test_trim + + !> Generator for checking the length of the character sequence + subroutine gen_len(str1, chr1) + type(my_string_type), intent(in) :: str1 + character(len=*), intent(in) :: chr1 + call check(len(str1) == len(chr1)) + end subroutine gen_len + + subroutine test_len + type(my_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) + + call check1("Example string", gen_len) + call check1("S P A C E D S T R I N G", gen_len) + call check1("With trailing whitespace ", gen_len) + call check1(" centered ", gen_len) + end subroutine test_len + + !> Generator for checking the length of the character sequence without whitespace + subroutine gen_len_trim(str1, chr1) + type(my_string_type), intent(in) :: str1 + character(len=*), intent(in) :: chr1 + call check(len_trim(str1) == len_trim(chr1)) + end subroutine gen_len_trim + + subroutine test_len_trim + type(my_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) + + call check1("Example string", gen_len_trim) + call check1("S P A C E D S T R I N G", gen_len_trim) + call check1("With trailing whitespace ", gen_len_trim) + call check1(" centered ", gen_len_trim) + end subroutine test_len_trim + + !> Generator for checking the left adjustment of the character sequence + subroutine gen_adjustl(str1, chr1) + type(my_string_type), intent(in) :: str1 + character(len=*), intent(in) :: chr1 + call check(adjustl(str1) == adjustl(chr1)) + end subroutine gen_adjustl + + subroutine test_adjustl + type(my_string_type) :: string + + string = " Whitespace" + string = adjustl(string) + call check(char(string) == "Whitespace ") + + call check1(" B L A N K S ", gen_adjustl) + end subroutine test_adjustl + + !> Generator for checking the right adjustment of the character sequence + subroutine gen_adjustr(str1, chr1) + type(my_string_type), intent(in) :: str1 + character(len=*), intent(in) :: chr1 + call check(adjustr(str1) == adjustr(chr1)) + end subroutine gen_adjustr + + subroutine test_adjustr + type(my_string_type) :: string + + string = "Whitespace " + string = adjustr(string) + call check(char(string) == " Whitespace") + + call check1(" B L A N K S ", gen_adjustr) + end subroutine test_adjustr + + !> Generator for checking the presence of a character set in a character sequence + subroutine gen_scan(str1, chr1, str2, chr2) + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + call check(scan(str1, str2) == scan(chr1, chr2)) + call check(scan(str1, chr2) == scan(chr1, chr2)) + call check(scan(chr1, str2) == scan(chr1, chr2)) + call check(scan(str1, str2, back=.true.) == scan(chr1, chr2, back=.true.)) + call check(scan(str1, chr2, back=.true.) == scan(chr1, chr2, back=.true.)) + call check(scan(chr1, str2, back=.true.) == scan(chr1, chr2, back=.true.)) + end subroutine gen_scan + + subroutine test_scan + type(my_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) + + call check2("fortran", "ao", gen_scan) + call check2("c++", "fortran", gen_scan) + + end subroutine test_scan + + !> Generator for checking the absence of a character set in a character sequence + subroutine gen_verify(str1, chr1, str2, chr2) + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + call check(verify(str1, str2) == verify(chr1, chr2)) + call check(verify(str1, chr2) == verify(chr1, chr2)) + call check(verify(chr1, str2) == verify(chr1, chr2)) + call check(verify(str1, str2, back=.true.) == verify(chr1, chr2, back=.true.)) + call check(verify(str1, chr2, back=.true.) == verify(chr1, chr2, back=.true.)) + call check(verify(chr1, str2, back=.true.) == verify(chr1, chr2, back=.true.)) + end subroutine gen_verify + + subroutine test_verify + type(my_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) + + call check2("fortran", "ao", gen_verify) + call check2("c++", "fortran", gen_verify) + + end subroutine test_verify + + !> Generator for the repeatition of a character sequence + subroutine gen_repeat(str1, chr1) + type(my_string_type), intent(in) :: str1 + character(len=*), intent(in) :: chr1 + integer :: i + do i = 12, 3, -2 + call check(repeat(str1, i) == repeat(chr1, i)) + end do + end subroutine gen_repeat + + subroutine test_repeat + type(my_string_type) :: string + + string = "What? " + string = repeat(string, 3) + call check(string == "What? What? What? ") + + call check1("!!1!", gen_repeat) + call check1("This sentence is repeated multiple times. ", gen_repeat) + + end subroutine test_repeat + + !> Generator for checking the substring search in a character string + subroutine gen_index(str1, chr1, str2, chr2) + type(my_string_type), intent(in) :: str1, str2 + character(len=*), intent(in) :: chr1, chr2 + call check(index(str1, str2) == index(chr1, chr2)) + call check(index(str1, chr2) == index(chr1, chr2)) + call check(index(chr1, str2) == index(chr1, chr2)) + call check(index(str1, str2, back=.true.) == index(chr1, chr2, back=.true.)) + call check(index(str1, chr2, back=.true.) == index(chr1, chr2, back=.true.)) + call check(index(chr1, str2, back=.true.) == index(chr1, chr2, back=.true.)) + end subroutine gen_index + + subroutine test_index + type(my_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) + + call check2("Search this string for this expression", "this", gen_index) + call check2("Search this string for this expression", "This", gen_index) + + end subroutine test_index + + subroutine test_char + type(my_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(my_string_type) :: string + integer :: code + + string = "Fortran" + code = ichar(string) + call check(code == ichar("F")) + end subroutine test_ichar + + subroutine test_iachar + type(my_string_type) :: string + integer :: code + + string = "Fortran" + code = iachar(string) + call check(code == iachar("F")) + end subroutine test_iachar + + subroutine test_listdirected_io + type(my_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(my_string_type) :: string + integer :: io, stat + string = "Important saved value" + + open(newunit=io, form="formatted", status="scratch") + 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(my_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 + + subroutine test_assignment + type(my_string_type) :: string + + call check(len(string) == 0) + + string = "Sequence" + call check(len(string) == 8) + end subroutine test_assignment + + subroutine test_gt + type(my_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(my_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(my_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(my_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(my_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(my_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(my_string_type) :: string + + string = "Hello, " + string = string // "World!" + call check(len(string) == 13) + end subroutine test_concat + +end module test_string_class + +program tester + use test_string_class + 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 + call test_listdirected_io + call test_formatted_io + call test_unformatted_io + call test_assignment + call test_gt + call test_lt + call test_ge + call test_le + call test_eq + call test_ne + call test_concat + +end program tester