diff --git a/doc/specs/index.md b/doc/specs/index.md index edd00ed95..bcdcf80c3 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -20,6 +20,7 @@ This is and index/directory of the specifications (specs) for each new module/fe - [quadrature](./stdlib_quadrature.html) - Numerical integration - [stats](./stdlib_stats.html) - Descriptive Statistics - [stats_distribution_PRNG](./stdlib_stats_distribution_PRNG.html) - Probability Distributions random number generator + - [string\_type](./stdlib_string_type.html) - Basic string support ## Missing specs diff --git a/doc/specs/stdlib_string_type.md b/doc/specs/stdlib_string_type.md new file mode 100644 index 000000000..c770e1f8a --- /dev/null +++ b/doc/specs/stdlib_string_type.md @@ -0,0 +1,1607 @@ +--- +title: string type +--- + +# The `stdlib_string_type` module + +[TOC] + +## Introduction + +The `stdlib_string_type` provides a derived type holding an arbitrary sequence +of characters compatible with most Fortran intrinsic character procedures as +well as operators for working with character variables and constants. + + +## Derived types provided + + + +### The `string_type` derived type + +The `string_type` is defined as a non-extenable derived type representing a +sequence of characters. The internal representation of the character sequence +is implementation dependent and not visible for the user of the module. + +#### Status + +Experimental + + +## Procedures and methods provided + +Procedures returning `string_type` instances can usually used in elemental +context, while procedures returning scalar character values can only be +used in a pure way. + + + +### Constructor for empty string + +The module defines a default constructor to create an empty string type. + +#### Description + +Creates a string instance representing an empty string. + +#### Syntax + +`res = [[stdlib_string_type(module):string_type(interface)]] ()` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +None. + +#### Result value + +The result is an instance of `string_type`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +string = string_type() +! len(string) == 0 +end +``` + + + +### Constructor from character scalar + +The module defines a default constructor to create a string type +from a character scalar. + +#### Description + +Creates a string instance representing the input character scalar value. +The constructor shall create an empty string if an unallocated deferred-length +character variable is passed. + +#### Syntax + +`res = [[stdlib_string_type(module):string_type(interface)]] (string)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +`string`: shall be a scalar character value. It is an `intent(in)` argument. + +#### Result value + +The result is an instance of `string_type`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +string = string_type("Sequence") +! len(string) == 8 +string = string_type(" S p a c e d ") +! len(string) == 9 +end +``` + + + +### Assignment of character scalar + +The module defines an assignment operations, `=`, to create a string type +from a character scalar. + +#### Description + +Creates a string instance representing the right-hand-side character scalar value. + +#### Syntax + +`lhs = rhs` + +#### Status + +Experimental + +#### Class + +Elemntal subroutine, `assignment(=)`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +! len(string) == 0 +string = "Sequence" +! len(string) == 8 +end +``` + + + +### Len function + +#### Description + +Returns the length of the character sequence represented by the string. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: length + +string = "Some longer sentence for this example." +length = len(string) +! length == 38 + +string = "Whitespace " +length = len(string) +! length == 38 +end +``` + + + +### Len\_trim function + +#### Description + +Returns the length of the character sequence without trailing spaces +represented by the string. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: length + +string = "Some longer sentence for this example." +length = len_trim(string) +! length == 38 + +string = "Whitespace " +length = len_trim(string) +! length == 10 +end +``` + + + +### Trim function + +#### Description + +Returns the character sequence hold by the string without trailing spaces +represented by a `string_type`. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string + +string = "Whitespace " +string = trim(string) +! len(string) == 10 +end +``` + + + +### Adjustl function + +#### Description + +Left-adjust the character sequence represented by the string. +The length of the character sequence remains unchanged. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string + +string = " Whitespace" +string = adjustl(string) +! char(string) == "Whitespace " +end +``` + + + +### Adjustr function + +#### Description + +Right-adjust the character sequence represented by the string. +The length of the character sequence remains unchanged. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string + +string = "Whitespace " +string = adjustr(string) +! char(string) == " Whitespace" +end +``` + + + +### Repeat function + +#### Description + +Repeats the character sequence hold by the string by the number of +specified copies. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string + +string = "What? " +string = repeat(string, 3) +! string == "What? What? What? " +end +``` + + + +### Char function + +#### Description + +Return the character sequence represented by the string. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +character(len=:), allocatable :: dlc + +string = "Character sequence" +dlc = char(string) +! dlc == "Character sequence" +end +``` + + + +### Char function (position variant) + +#### Description + +Return the character sequence represented by the string. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +character(len=:), allocatable :: dlc +character(len=1), allocatable :: chars(:) + +string = "Character sequence" +dlc = char(string, 3) +! dlc == "a" +chars = char(string, [3, 5, 8, 12, 14, 15, 18]) +! chars == ["a", "a", "e", "e", "u", "e", "e"] +end +``` + + + +### Char function (range variant) + +#### Description + +Return the character sequence represented by the string. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +character(len=:), allocatable :: dlc + +string = "Fortran" +dlc = char(string, 1, 4) +! dlc == "Fort" +end +``` + + + +### Ichar function + +Character-to-integer conversion function. + +#### Description + +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_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: code + +string = "Fortran" +code = ichar(string) +end +``` + + + +### Iachar function + +Code in ASCII collating sequence. + +#### Description + +Returns the code for the ASCII character in the first character position of +the character sequences represent by the string. + +#### Syntax + +`res = [[stdlib_string_type(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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: code + +string = "Fortran" +code = iachar(string) +end +``` + + + +### Index function + +Position of a *substring* within a *string*. + +#### Description + +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_type(module):index(interface)]] (string, substring[, back])` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Either scalar character value or string type. This argument is `intent(in)`. +- `substring`: Either scalar character value or string type. 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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: pos + +string = "Search this string for this expression" +pos = index(string, "this") +! pos == 8 + +pos = index(string, "this", back=.true.) +! pos == 24 + +pos = index(string, "This") +! pos == 0 +end +``` + + + +### Scan function + +Scan a *string* for the presence of a *set* of characters. Scans a *string* for +any of the characters in a *set* of characters. + +#### Description + +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_type(module):scan(interface)]] (string, set[, back])` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Either scalar character value or string type. This argument is `intent(in)`. +- `set`: Either scalar character value or string type. 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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: pos + +string = "fortran" +pos = scan(string, "ao") +! pos == 2 + +pos = scan(string, "ao", .true.) +! pos == 6 + +pos = scan(string, "c++") +! pos == 0 +end +``` + + + +### Verify function + +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. + +#### Description + +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_type(module):verify(interface)]] (string, set[, back])` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `string`: Either scalar character value or string type. This argument is `intent(in)`. +- `set`: Either scalar character value or string type. 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. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: pos + +string = "fortran" +pos = verify(string, "ao") +! pos == 1 + +pos = verify(string, "fo") +! pos == 3 + +pos = verify(string, "c++") +! pos == 1 + +pos = verify(string, "c++", back=.true.) +! pos == 7 + +pos = verify(string, string) +! pos == 0 +end +``` + + + +### Lgt function (lexical greater) + +Lexically compare the order of two character sequences being greater. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `lgt` procedure. + +#### Syntax + +`res = [[stdlib_string_type(module):lgt(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = lgt(string, "abc") +! res .eqv. .true. + +res = lgt(string, "bcd") +! res .eqv. .false. + +res = lgt(string, "cde") +! res .eqv. .false. +end +``` + + + +### Llt function (lexical less) + +Lexically compare the order of two character sequences being less. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `llt` procedure. + +#### Syntax + +`res = [[stdlib_string_type(module):llt(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = llt(string, "abc") +! res .eqv. .false. + +res = llt(string, "bcd") +! res .eqv. .false. + +res = llt(string, "cde") +! res .eqv. .true. +end +``` + + + +### Lge function (lexical greater or equal) + +Lexically compare the order of two character sequences being greater or equal. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `lge` procedure. + +#### Syntax + +`res = [[stdlib_string_type(module):lge(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = lge(string, "abc") +! res .eqv. .true. + +res = lge(string, "bcd") +! res .eqv. .true. + +res = lge(string, "cde") +! res .eqv. .false. +end +``` + + + +### Lle function (lexical less or equal) + +Lexically compare the order of two character sequences being less or equal. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `lle` procedure. + +#### Syntax + +`res = [[stdlib_string_type(module):lle(interface)]] (lhs, rhs)` + +#### Status + +Experimental + +#### Class + +Elemental function. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = lle(string, "abc") +! res .eqv. .false. + +res = lle(string, "bcd") +! res .eqv. .true. + +res = lle(string, "cde") +! res .eqv. .true. +end +``` + + + +### Comparison operator greater + +Compare the order of two character sequences being greater. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `operator(.gt.)`. + +#### Syntax + +`res = lhs > rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(.gt.)`. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = string > "abc" +! res .eqv. .true. + +res = string > "bcd" +! res .eqv. .false. + +res = string > "cde" +! res .eqv. .false. +end +``` + + + +### Comparison operator less + +Compare the order of two character sequences being less. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `operator(.lt.)`. + +#### Syntax + +`res = lhs < rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(.lt.)`. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = string < "abc" +! res .eqv. .false. + +res = string < "bcd" +! res .eqv. .false. + +res = string < "cde" +! res .eqv. .true. +end +``` + + + +### Comparison operator greater or equal + +Compare the order of two character sequences being greater or equal. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `operator(.ge.)`. + +#### Syntax + +`res = lhs >= rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(.ge.)`. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = string >= "abc" +! res .eqv. .true. + +res = string >= "bcd" +! res .eqv. .true. + +res = string >= "cde" +! res .eqv. .false. +end +``` + + + +### Comparison operator less or equal + +Compare the order of two character sequences being less or equal. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `operator(.le.)`. + +#### Syntax + +`res = lhs <= rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(.le.)`. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = string <= "abc" +! res .eqv. .false. + +res = string <= "bcd" +! res .eqv. .true. + +res = string <= "cde" +! res .eqv. .true. +end +``` + + + +### Comparison operator equal + +Compare two character sequences for equality. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `operator(.eq.)`. + +#### Syntax + +`res = lhs == rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(.eq.)`. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = string == "abc" +! res .eqv. .false. + +res = string == "bcd" +! res .eqv. .true. + +res = string == "cde" +! res .eqv. .false. +end +``` + + + +### Comparison operator not equal + +Compare two character sequences for inequality. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `operator(.ne.)`. + +#### Syntax + +`res = lhs /= rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(.ne.)`. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is a default logical scalar value. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +logical :: res + +string = "bcd" +res = string /= "abc" +! res .eqv. .true. + +res = string /= "bcd" +! res .eqv. .false. + +res = string /= "cde" +! res .eqv. .true. +end +``` + + + +### Concatenation operator + +Concatenate two character sequences. + +#### Description + +The left-hand side, the right-hand side or both character sequences can +be represented by a string type. +This defines three procedures overloading the intrinsic `operator(//)`. + +#### Syntax + +`res = lhs // rhs` + +#### Status + +Experimental + +#### Class + +Elemental function, `operator(//)`. + +#### Argument + +- `lhs`: Either scalar character value or string type. This argument is `intent(in)`. +- `rhs`: Either scalar character value or string type. This argument is `intent(in)`. + +#### Result value + +The result is an instance of `string_type`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string + +string = "Hello, " +string = string // "World!" +! len(string) == 13 +end +``` + + + +### 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)`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: io +string = "Important saved value" + +open(newunit=io, form="unformatted", status="scratch") +write(io) string + +rewind(io) + +read(io) string +close(io) +end +``` + + +### Formatted write + +#### Description + +Write the character sequence hold by the string to a connected formatted unit. + +The current implementation is limited to list directed output and `dt` formatted +output. Requesting namelist output will raise an error. + +#### Syntax + +`write(unit, fmt, iostat=iostat, iomsg=iomsg) string` + +#### Status + +Experimental + +#### Class + +Formatted 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)`. +- `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)`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: io +string = "Important saved value" + +open(newunit=io, form="formatted", status="scratch") +write(io, *) string +write(io, *) + +rewind(io) + +read(io, *) string +close(io) +end +``` + + + +### 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 type 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)`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: io +string = "Important saved value" + +open(newunit=io, form="unformatted", status="scratch") +write(io) string + +rewind(io) + +read(io) string +close(io) +end +``` + + + +### 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. + +The current implementation is limited to list directed input. +Requesting `dt` formatted input or namelist output will raise an error. + +#### Syntax + +`read(unit, fmt, iostat=iostat, iomsg=iomsg) string` + +#### Status + +Experimental + +#### Class + +Formatted derived type input. + +#### Argument + +- `string`: Instance of the string type 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)`. + +#### Example + +```fortran +use stdlib_string_type +implicit none +type(string_type) :: string +integer :: io +string = "Important saved value" + +open(newunit=io, form="formatted", status="scratch") +write(io, *) string +write(io, *) + +rewind(io) + +read(io, *) string +close(io) +end +``` diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 2429f555a..85f5c68b6 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_type.f90 stdlib_system.F90 ${outFiles} ) diff --git a/src/Makefile.manual b/src/Makefile.manual index a57253e2b..804b04272 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_type.f90 \ $(SRCGEN) LIB = libstdlib.a diff --git a/src/stdlib_string_type.f90 b/src/stdlib_string_type.f90 new file mode 100644 index 000000000..02e038982 --- /dev/null +++ b/src/stdlib_string_type.f90 @@ -0,0 +1,1102 @@ +! SPDX-Identifier: MIT + +!> Implementation of a string type to hold an arbitrary sequence of characters. +!> +!> This module provides string type compatible with all Fortran instrinsic character +!> procedures as well as overloaded operators for working with character variables. +!> +!> A string type can be easily constructed by creating a new instance from a +!> character variable or literal by invoking its constructor or by assigning it +!> to a string type. Generally, the string type behaves similar to a deferred +!> length character in most regards but adds memory access safety. +!> +!> The specification of this module is available [here](../page/specs/stdlib_string_type.html). +module stdlib_string_type + implicit none + private + + public :: string_type + public :: len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl + public :: lgt, lge, llt, lle, char, ichar, iachar + public :: assignment(=) + public :: operator(.gt.), operator(.ge.), operator(.lt.), operator(.le.) + public :: operator(.eq.), operator(.ne.), operator(//) + public :: write(formatted), write(unformatted) + public :: read(formatted), read(unformatted) + + + integer, parameter :: long = selected_int_kind(18) + + + !> String type holding an arbitrary sequence of characters. + type :: string_type + sequence + private + character(len=:), allocatable :: raw + end type string_type + + !> Constructor for new string instances + interface string_type + module procedure :: new_string + end interface string_type + + + !> 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_string + 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_string + 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_string + 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_string + 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_string + 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_string + 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_string + module procedure :: char_string_pos + module procedure :: char_string_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_string + end interface ichar + + !> Code in ASCII collating sequence. + !> + !> This method is elemental and returns a default integer scalar value. + interface iachar + module procedure :: iachar_string + 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_string_string + module procedure :: index_string_char + module procedure :: index_char_string + 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_string_string + module procedure :: scan_string_char + module procedure :: scan_char_string + 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_string_string + module procedure :: verify_string_char + module procedure :: verify_char_string + 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_string_string + module procedure :: lgt_string_char + module procedure :: lgt_char_string + 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_string_string + module procedure :: llt_string_char + module procedure :: llt_char_string + 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_string_string + module procedure :: lge_string_char + module procedure :: lge_char_string + 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_string_string + module procedure :: lle_string_char + module procedure :: lle_char_string + end interface lle + + !> Assign a character sequence to a string. + interface assignment(=) + module procedure :: assign_string_char + end interface assignment(=) + + !> Compare two character sequences for being greater, the left-hand side, + !> the right-hand side or both character sequences can be represented by + !> a string. + !> + !> This operator is elemental and returns a default logical scalar value. + interface operator(.gt.) + module procedure :: gt_string_string + module procedure :: gt_string_char + module procedure :: gt_char_string + end interface operator(.gt.) + + !> Compare two character sequences for being less, the left-hand side, + !> the right-hand side or both character sequences can be represented by + !> a string. + !> + !> This operator is elemental and returns a default logical scalar value. + interface operator(.lt.) + module procedure :: lt_string_string + module procedure :: lt_string_char + module procedure :: lt_char_string + end interface operator(.lt.) + + !> Compare two character sequences for being greater than, the left-hand side, + !> the right-hand side or both character sequences can be represented by + !> a string. + !> + !> This operator is elemental and returns a default logical scalar value. + interface operator(.ge.) + module procedure :: ge_string_string + module procedure :: ge_string_char + module procedure :: ge_char_string + end interface operator(.ge.) + + !> Compare two character sequences for being less than, the left-hand side, + !> the right-hand side or both character sequences can be represented by + !> a string. + !> + !> This operator is elemental and returns a default logical scalar value. + interface operator(.le.) + module procedure :: le_string_string + module procedure :: le_string_char + module procedure :: le_char_string + end interface operator(.le.) + + !> Compare two character sequences for equality, the left-hand side, + !> the right-hand side or both character sequences can be represented by + !> a string. + !> + !> This operator is elemental and returns a default logical scalar value. + interface operator(.eq.) + module procedure :: eq_string_string + module procedure :: eq_string_char + module procedure :: eq_char_string + end interface operator(.eq.) + + !> Compare two character sequences for inequality, the left-hand side, + !> the right-hand side or both character sequences can be represented by + !> a string. + !> + !> This operator is elemental and returns a default logical scalar value. + interface operator(.ne.) + module procedure :: ne_string_string + module procedure :: ne_string_char + module procedure :: ne_char_string + end interface operator(.ne.) + + !> Concatenate two character sequences, the left-hand side, the right-hand side + !> or both character sequences can be represented by a string. + !> + !> This operator is elemental and returns a scalar character value. + interface operator(//) + module procedure :: concat_string_string + module procedure :: concat_string_char + module procedure :: concat_char_string + end interface operator(//) + + !> Write the character sequence hold by the string to a connected formatted + !> unit. + interface write(formatted) + module procedure :: write_formatted + end interface + + !> Write the character sequence hold by the string to a connected unformatted + !> unit. + interface write(unformatted) + module procedure :: write_unformatted + end interface + + !> Read a character sequence from a connected unformatted unit into the string. + interface read(formatted) + module procedure :: read_formatted + end interface + + !> Read a character sequence from a connected unformatted unit into the string. + interface read(unformatted) + module procedure :: read_unformatted + end interface + + +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(string_type) :: new + if (present(string)) then + new%raw = string + end if + end function new_string + + + !> Assign a character sequence to a string. + elemental subroutine assign_string_char(lhs, rhs) + type(string_type), intent(inout) :: lhs + character(len=*), intent(in) :: rhs + lhs%raw = rhs + end subroutine assign_string_char + + + !> Returns the length of the character sequence represented by the string. + elemental function len_string(string) result(length) + type(string_type), intent(in) :: string + integer :: length + + if (allocated(string%raw)) then + length = len(string%raw) + else + length = 0 + end if + + end function len_string + + + !> Returns the length of the character sequence without trailing spaces + !> represented by the string. + elemental function len_trim_string(string) result(length) + type(string_type), intent(in) :: string + integer :: length + + length = merge(len_trim(string%raw), 0, allocated(string%raw)) + + end function len_trim_string + + + !> Character-to-integer conversion function. + elemental function ichar_string(string) result(ich) + type(string_type), intent(in) :: string + integer :: ich + + ich = merge(ichar(string%raw), 0, allocated(string%raw)) + + end function ichar_string + + + !> Code in ASCII collating sequence. + elemental function iachar_string(string) result(ich) + type(string_type), intent(in) :: string + integer :: ich + + ich = merge(iachar(string%raw), 0, allocated(string%raw)) + + end function iachar_string + + + !> Return the character sequence represented by the string. + pure function char_string(string) result(character_string) + type(string_type), intent(in) :: string + ! GCC 8 and older cannot evaluate pure derived type procedures here + !character(len=len(string)) :: character_string + character(len=:), allocatable :: character_string + + character_string = maybe(string) + + end function char_string + + !> Return the character sequence represented by the string. + elemental function char_string_pos(string, pos) result(character_string) + type(string_type), intent(in) :: string + integer, intent(in) :: pos + character(len=1) :: character_string + + character_string = merge(string%raw(pos:pos), ' ', allocated(string%raw)) + + end function char_string_pos + + !> Return the character sequence represented by the string. + pure function char_string_range(string, start, last) result(character_string) + type(string_type), intent(in) :: string + integer, intent(in) :: start + integer, intent(in) :: last + character(len=last-start+1) :: character_string + + character_string = merge(string%raw(int(start, long):int(last, long)), & + repeat(' ', int(len(character_string), long)), allocated(string%raw)) + + end function char_string_range + + + !> Returns the character sequence hold by the string without trailing spaces. + elemental function trim_string(string) result(trimmed_string) + type(string_type), intent(in) :: string + type(string_type) :: trimmed_string + + trimmed_string = trim(maybe(string)) + + end function trim_string + + + !> Left-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + elemental function adjustl_string(string) result(adjusted_string) + type(string_type), intent(in) :: string + type(string_type) :: adjusted_string + + adjusted_string = adjustl(maybe(string)) + + end function adjustl_string + + + !> Right-adjust the character sequence represented by the string. + !> The length of the character sequence remains unchanged. + elemental function adjustr_string(string) result(adjusted_string) + type(string_type), intent(in) :: string + type(string_type) :: adjusted_string + + adjusted_string = adjustr(maybe(string)) + + end function adjustr_string + + + !> Repeats the character sequence hold by the string by the number of + !> specified copies. + elemental function repeat_string(string, ncopies) result(repeated_string) + type(string_type), intent(in) :: string + integer, intent(in) :: ncopies + type(string_type) :: repeated_string + + repeated_string = repeat(maybe(string), ncopies) + + end function repeat_string + + + !> Position of a sequence of character within a character sequence. + !> In this version both character sequences are represented by a string. + elemental function index_string_string(string, substring, back) result(pos) + type(string_type), intent(in) :: string + type(string_type), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + + pos = index(maybe(string), maybe(substring), & + merge(back, .false., present(back))) + + end function index_string_string + + !> Position of a sequence of character within a character sequence. + !> In this version the main character sequence is represented by a string. + elemental function index_string_char(string, substring, back) result(pos) + type(string_type), intent(in) :: string + character(len=*), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + + pos = index(maybe(string), substring, & + merge(back, .false., present(back))) + + end function index_string_char + + !> Position of a sequence of character within a character sequence. + !> In this version the sub character sequence is represented by a string. + elemental function index_char_string(string, substring, back) result(pos) + character(len=*), intent(in) :: string + type(string_type), intent(in) :: substring + logical, intent(in), optional :: back + integer :: pos + + pos = index(string, maybe(substring), & + merge(back, .false., present(back))) + + end function index_char_string + + + !> Scan a character sequence for any of the characters in a set of characters. + !> In this version both the character sequence and the character set are + !> represented by a string. + elemental function scan_string_string(string, set, back) result(pos) + type(string_type), intent(in) :: string + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = scan(maybe(string), maybe(set), & + merge(back, .false., present(back))) + + end function scan_string_string + + !> Scan a character sequence for any of the characters in a set of characters. + !> In this version the character sequences is represented by a string. + elemental function scan_string_char(string, set, back) result(pos) + type(string_type), intent(in) :: string + character(len=*), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = scan(maybe(string), set, & + merge(back, .false., present(back))) + + end function scan_string_char + + !> Scan a character sequence for any of the characters in a set of characters. + !> In this version the set of characters is represented by a string. + elemental function scan_char_string(string, set, back) result(pos) + character(len=*), intent(in) :: string + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = scan(string, maybe(set), & + merge(back, .false., present(back))) + + end function scan_char_string + + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. In this version both the character sequence and + !> the character set are represented by a string. + elemental function verify_string_string(string, set, back) result(pos) + type(string_type), intent(in) :: string + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = verify(maybe(string), maybe(set), & + merge(back, .false., present(back))) + + end function verify_string_string + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. In this version the character sequences is + !> represented by a string. + elemental function verify_string_char(string, set, back) result(pos) + type(string_type), intent(in) :: string + character(len=*), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = verify(maybe(string), set, & + merge(back, .false., present(back))) + + end function verify_string_char + + !> Verify a character sequence for the absence any of the characters in + !> a set of characters. In this version the set of characters is + !> represented by a string. + elemental function verify_char_string(string, set, back) result(pos) + character(len=*), intent(in) :: string + type(string_type), intent(in) :: set + logical, intent(in), optional :: back + integer :: pos + + pos = verify(string, maybe(set), & + merge(back, .false., present(back))) + + end function verify_char_string + + + !> Compare two character sequences for being greater. + !> In this version both character sequences are by a string. + elemental function gt_string_string(lhs, rhs) result(is_gt) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_gt + + is_gt = maybe(lhs) > maybe(rhs) + + end function gt_string_string + + !> Compare two character sequences for being greater. + !> In this version the left-hand side character sequences is by a string. + elemental function gt_string_char(lhs, rhs) result(is_gt) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_gt + + is_gt = maybe(lhs) > rhs + + end function gt_string_char + + !> Compare two character sequences for being greater. + !> In this version the right-hand side character sequences is by a string. + elemental function gt_char_string(lhs, rhs) result(is_gt) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_gt + + is_gt = lhs > maybe(rhs) + + end function gt_char_string + + + !> Compare two character sequences for being less. + !> In this version both character sequences are by a string. + elemental function lt_string_string(lhs, rhs) result(is_lt) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_string_string + + + !> Compare two character sequences for being less. + !> In this version the left-hand side character sequences is by a string. + elemental function lt_string_char(lhs, rhs) result(is_lt) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_string_char + + !> Compare two character sequences for being less. + !> In this version the right-hand side character sequences is by a string. + elemental function lt_char_string(lhs, rhs) result(is_lt) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lt + + is_lt = rhs > lhs + + end function lt_char_string + + + !> Compare two character sequences for being greater or equal. + !> In this version both character sequences are by a string. + elemental function ge_string_string(lhs, rhs) result(is_ge) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_string_string + + !> Compare two character sequences for being greater or equal. + !> In this version the left-hand side character sequences is by a string. + elemental function ge_string_char(lhs, rhs) result(is_ge) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_string_char + + !> Compare two character sequences for being greater or equal + !> In this version the right-hand side character sequences is by a string. + elemental function ge_char_string(lhs, rhs) result(is_ge) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_ge + + is_ge = .not. (rhs > lhs) + + end function ge_char_string + + + !> Compare two character sequences for being less or equal. + !> In this version both character sequences are by a string. + elemental function le_string_string(lhs, rhs) result(is_le) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_string_string + + !> Compare two character sequences for being less or equal. + !> In this version the left-hand side character sequences is by a string. + elemental function le_string_char(lhs, rhs) result(is_le) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_string_char + + !> Compare two character sequences for being less or equal + !> In this version the right-hand side character sequences is by a string. + elemental function le_char_string(lhs, rhs) result(is_le) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_le + + is_le = .not. (lhs > rhs) + + end function le_char_string + + + !> Compare two character sequences for equality. + !> In this version both character sequences are by a string. + elemental function eq_string_string(lhs, rhs) result(is_eq) + type(string_type), 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_string_string + + !> Compare two character sequences for equality. + !> In this version the left-hand side character sequences is by a string. + elemental function eq_string_char(lhs, rhs) result(is_eq) + type(string_type), 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_string_char + + !> Compare two character sequences for equality. + !> In this version the right-hand side character sequences is by a string. + elemental function eq_char_string(lhs, rhs) result(is_eq) + character(len=*), 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_char_string + + + !> Compare two character sequences for inequality. + !> In this version both character sequences are by a string. + elemental function ne_string_string(lhs, rhs) result(is_ne) + type(string_type), 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_string_string + + !> Compare two character sequences for inequality. + !> In this version the left-hand side character sequences is by a string. + elemental function ne_string_char(lhs, rhs) result(is_ne) + type(string_type), 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_string_char + + !> Compare two character sequences for inequality. + !> In this version the right-hand side character sequences is by a string. + elemental function ne_char_string(lhs, rhs) result(is_ne) + character(len=*), 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_char_string + + + !> Lexically compare two character sequences for being greater. + !> In this version both character sequences are by a string. + elemental function lgt_string_string(lhs, rhs) result(is_lgt) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(maybe(lhs), maybe(rhs)) + + end function lgt_string_string + + !> Lexically compare two character sequences for being greater. + !> In this version the left-hand side character sequences is by a string. + elemental function lgt_string_char(lhs, rhs) result(is_lgt) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(maybe(lhs), rhs) + + end function lgt_string_char + + !> Lexically compare two character sequences for being greater. + !> In this version the right-hand side character sequences is by a string. + elemental function lgt_char_string(lhs, rhs) result(is_lgt) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lgt + + is_lgt = lgt(lhs, maybe(rhs)) + + end function lgt_char_string + + + !> Lexically compare two character sequences for being less. + !> In this version both character sequences are by a string. + elemental function llt_string_string(lhs, rhs) result(is_llt) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(maybe(lhs), maybe(rhs)) + + end function llt_string_string + + !> Lexically compare two character sequences for being less. + !> In this version the left-hand side character sequences is by a string. + elemental function llt_string_char(lhs, rhs) result(is_llt) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(maybe(lhs), rhs) + + end function llt_string_char + + !> Lexically compare two character sequences for being less. + !> In this version the right-hand side character sequences is by a string. + elemental function llt_char_string(lhs, rhs) result(is_llt) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_llt + + is_llt = llt(lhs, maybe(rhs)) + + end function llt_char_string + + + !> Lexically compare two character sequences for being greater or equal. + !> In this version both character sequences are by a string. + elemental function lge_string_string(lhs, rhs) result(is_lge) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(maybe(lhs), maybe(rhs)) + + end function lge_string_string + + !> Lexically compare two character sequences for being greater or equal. + !> In this version the left-hand side character sequences is by a string. + elemental function lge_string_char(lhs, rhs) result(is_lge) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(maybe(lhs), rhs) + + end function lge_string_char + + !> Lexically compare two character sequences for being greater or equal + !> In this version the right-hand side character sequences is by a string. + elemental function lge_char_string(lhs, rhs) result(is_lge) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lge + + is_lge = lge(lhs, maybe(rhs)) + + end function lge_char_string + + + !> Lexically compare two character sequences for being less or equal. + !> In this version both character sequences are by a string. + elemental function lle_string_string(lhs, rhs) result(is_lle) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(maybe(lhs), maybe(rhs)) + + end function lle_string_string + + !> Lexically compare two character sequences for being less or equal. + !> In this version the left-hand side character sequences is by a string. + elemental function lle_string_char(lhs, rhs) result(is_lle) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(maybe(lhs), rhs) + + end function lle_string_char + + !> Lexically compare two character sequences for being less or equal + !> In this version the right-hand side character sequences is by a string. + elemental function lle_char_string(lhs, rhs) result(is_lle) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + logical :: is_lle + + is_lle = lle(lhs, maybe(rhs)) + + end function lle_char_string + + + !> Concatenate two character sequences. + !> In this version both character sequences are by a string. + elemental function concat_string_string(lhs, rhs) result(string) + type(string_type), intent(in) :: lhs + type(string_type), intent(in) :: rhs + type(string_type) :: string + + string%raw = maybe(rhs) // maybe(lhs) + + end function concat_string_string + + !> Concatenate two character sequences. + !> In this version the left-hand side character sequences is by a string. + elemental function concat_string_char(lhs, rhs) result(string) + type(string_type), intent(in) :: lhs + character(len=*), intent(in) :: rhs + type(string_type) :: string + + string%raw = maybe(lhs) // rhs + + end function concat_string_char + + !> Concatenate two character sequences. + !> In this version the right-hand side character sequences is by a string. + elemental function concat_char_string(lhs, rhs) result(string) + character(len=*), intent(in) :: lhs + type(string_type), intent(in) :: rhs + type(string_type) :: string + + string%raw = lhs // maybe(rhs) + + end function concat_char_string + + + !> Write the character sequence hold by the string to a connected unformatted + !> unit. + subroutine write_unformatted(string, unit, iostat, iomsg) + type(string_type), intent(in) :: string + integer, intent(in) :: unit + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + + write(unit, iostat=iostat, iomsg=iomsg) int(len(string), long) + if (iostat == 0) then + write(unit, iostat=iostat, iomsg=iomsg) maybe(string) + end if + + end subroutine write_unformatted + + !> Write the character sequence hold by the string to a connected formatted + !> unit. + subroutine write_formatted(string, unit, iotype, v_list, iostat, iomsg) + type(string_type), intent(in) :: string + integer, intent(in) :: unit + character(len=*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + + select case(iotype) + case("LISTDIRECTED") + write(unit, '(a)', iostat=iostat, iomsg=iomsg) maybe(string) + case("NAMELIST") + error stop "[Fatal] This implementation does not support namelist output" + case default ! DT* + select case(size(v_list)) + case(0) ! DT + write(unit, '(a)', iostat=iostat, iomsg=iomsg) maybe(string) + case default + error stop "[Fatal] This implementation does not support v_list formatters" + end select + end select + + end subroutine write_formatted + + + !> Read a character sequence from a connected unformatted unit into the string. + subroutine read_unformatted(string, unit, iostat, iomsg) + type(string_type), intent(inout) :: string + integer, intent(in) :: unit + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + character(len=:), allocatable :: buffer + integer(long) :: chunk + + read(unit, iostat=iostat, iomsg=iomsg) chunk + if (iostat == 0) then + allocate(character(len=chunk) :: buffer) + read(unit, iostat=iostat, iomsg=iomsg) buffer + string%raw = buffer + end if + + end subroutine read_unformatted + + !> Read a character sequence from a connected formatted unit into the string. + subroutine read_formatted(string, unit, iotype, v_list, iostat, iomsg) + type(string_type), intent(inout) :: string + integer, intent(in) :: unit + character(len=*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + character(len=:), allocatable :: line + + call unused_dummy_argument(v_list) + + select case(iotype) + case("LISTDIRECTED") + call read_line(unit, line, iostat, iomsg) + case("NAMELIST") + error stop "[Fatal] This implementation does not support namelist input" + case default ! DT* + error stop "[Fatal] This implementation does not support dt formatters" + end select + + string%raw = line + + contains + + !> Internal routine to read a whole record from a formatted unit + subroutine read_line(unit, line, iostat, iomsg) + integer, intent(in) :: unit + character(len=:), allocatable, intent(out) :: line + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + integer, parameter :: buffer_size = 512 + character(len=buffer_size) :: buffer + integer :: chunk + line = '' + do + read(unit, '(a)', iostat=iostat, iomsg=iomsg, size=chunk, advance='no') & + buffer + if (iostat > 0) exit + line = line // buffer(:chunk) + if (iostat < 0) exit + end do + + if (is_iostat_eor(iostat)) then + iostat = 0 + end if + end subroutine read_line + + 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 + + + !> Safely return the character sequences represented by the string + pure function maybe(string) result(maybe_string) + type(string_type), intent(in) :: string + ! GCC 8 and older cannot evaluate pure derived type procedures here + !character(len=len(string)) :: maybe_string + character(len=:), allocatable :: maybe_string + if (allocated(string%raw)) then + maybe_string = string%raw + else + maybe_string = '' + end if + end function maybe + + +end module stdlib_string_type diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 6ea284d00..288445de9 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -13,6 +13,7 @@ add_subdirectory(linalg) add_subdirectory(logger) add_subdirectory(optval) add_subdirectory(stats) +add_subdirectory(string) add_subdirectory(system) add_subdirectory(quadrature) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index 89325cd56..553a69bed 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -8,6 +8,7 @@ all: $(MAKE) -f Makefile.manual --directory=optval $(MAKE) -f Makefile.manual --directory=quadrature $(MAKE) -f Makefile.manual --directory=stats + $(MAKE) -f Makefile.manual --directory=string test: $(MAKE) -f Makefile.manual --directory=ascii test @@ -17,6 +18,7 @@ test: $(MAKE) -f Makefile.manual --directory=optval test $(MAKE) -f Makefile.manual --directory=quadrature test $(MAKE) -f Makefile.manual --directory=stats test + $(MAKE) -f Makefile.manual --directory=string test clean: $(MAKE) -f Makefile.manual --directory=ascii clean @@ -25,3 +27,4 @@ clean: $(MAKE) -f Makefile.manual --directory=logger clean $(MAKE) -f Makefile.manual --directory=optval clean $(MAKE) -f Makefile.manual --directory=stats clean + $(MAKE) -f Makefile.manual --directory=string clean diff --git a/src/tests/string/CMakeLists.txt b/src/tests/string/CMakeLists.txt new file mode 100644 index 000000000..bda103c7b --- /dev/null +++ b/src/tests/string/CMakeLists.txt @@ -0,0 +1,5 @@ +ADDTEST(string_assignment) +ADDTEST(string_operator) +ADDTEST(string_intrinsic) +ADDTEST(string_derivedtype_io) + diff --git a/src/tests/string/Makefile.manual b/src/tests/string/Makefile.manual new file mode 100644 index 000000000..e3789447d --- /dev/null +++ b/src/tests/string/Makefile.manual @@ -0,0 +1,7 @@ +PROGS_SRC = test_string_assignment.f90 \ + test_string_derivedtype_io.f90 \ + test_string_intrinsic.f90 \ + test_string_operator.f90 + + +include ../Makefile.manual.test.mk diff --git a/src/tests/string/test_string_assignment.f90 b/src/tests/string/test_string_assignment.f90 new file mode 100644 index 000000000..f76c8724a --- /dev/null +++ b/src/tests/string/test_string_assignment.f90 @@ -0,0 +1,27 @@ +! SPDX-Identifier: MIT +module test_string_assignment + use stdlib_error, only : check + use stdlib_string_type, only : string_type, assignment(=), len + implicit none + +contains + + subroutine test_assignment + type(string_type) :: string + + call check(len(string) == 0) + + string = "Sequence" + call check(len(string) == 8) + end subroutine test_assignment + +end module test_string_assignment + +program tester + use test_string_assignment + implicit none + + call test_assignment + +end program tester + diff --git a/src/tests/string/test_string_derivedtype_io.f90 b/src/tests/string/test_string_derivedtype_io.f90 new file mode 100644 index 000000000..100e6f063 --- /dev/null +++ b/src/tests/string/test_string_derivedtype_io.f90 @@ -0,0 +1,80 @@ +! SPDX-Identifer: MIT +module test_string_derivedtype_io + use stdlib_error, only : check + use stdlib_string_type, only : string_type, assignment(=), len, & + write(formatted), read(formatted), write(unformatted), read(unformatted), & + operator(.eq.) + implicit none + +contains + + subroutine test_listdirected_io + type(string_type) :: string + integer :: io, stat + string = "Important saved value" + + open(newunit=io, form="formatted", status="scratch") + write(io, *) string + write(io, *) ! Pad with a newline or we might run into EOF while reading + + string = "" + rewind(io) + + read(io, *, iostat=stat) string + close(io) + + call check(stat == 0) + call check(len(string) == 21) + call check(string == "Important saved value") + end subroutine test_listdirected_io + + subroutine test_formatted_io + type(string_type) :: string + integer :: io, stat + string = "Important saved value" + + !open(newunit=io, form="formatted", status="scratch") + open(newunit=io, form="formatted", file="scratch.txt") + write(io, '(dt)') string + write(io, '(a)') ! Pad with a newline or we might run into EOF while reading + + string = "" + rewind(io) + + read(io, *, iostat=stat) string + close(io) + + call check(stat == 0) + call check(len(string) == 21) + call check(string == "Important saved value") + end subroutine test_formatted_io + + subroutine test_unformatted_io + type(string_type) :: string + integer :: io + string = "Important saved value" + + open(newunit=io, form="unformatted", status="scratch") + write(io) string + + string = "" + rewind(io) + + read(io) string + close(io) + + call check(len(string) == 21) + call check(string == "Important saved value") + end subroutine test_unformatted_io + +end module test_string_derivedtype_io + +program tester + use test_string_derivedtype_io + implicit none + + call test_listdirected_io + call test_formatted_io + call test_unformatted_io + +end program tester diff --git a/src/tests/string/test_string_intrinsic.f90 b/src/tests/string/test_string_intrinsic.f90 new file mode 100644 index 000000000..1341fca9c --- /dev/null +++ b/src/tests/string/test_string_intrinsic.f90 @@ -0,0 +1,239 @@ +! SPDX-Identifer: MIT +module test_string_intrinsic + use stdlib_error, only : check + use stdlib_string_type + implicit none + +contains + + subroutine test_lgt + type(string_type) :: string + logical :: res + + string = "bcd" + res = lgt(string, "abc") + call check(res .eqv. .true.) + + res = lgt(string, "bcd") + call check(res .eqv. .false.) + + res = lgt(string, "cde") + call check(res .eqv. .false.) + end subroutine test_lgt + + subroutine test_llt + type(string_type) :: string + logical :: res + + string = "bcd" + res = llt(string, "abc") + call check(res .eqv. .false.) + + res = llt(string, "bcd") + call check(res .eqv. .false.) + + res = llt(string, "cde") + call check(res .eqv. .true.) + end subroutine test_llt + + subroutine test_lge + type(string_type) :: string + logical :: res + + string = "bcd" + res = lge(string, "abc") + call check(res .eqv. .true.) + + res = lge(string, "bcd") + call check(res .eqv. .true.) + + res = lge(string, "cde") + call check(res .eqv. .false.) + end subroutine test_lge + + subroutine test_lle + type(string_type) :: string + logical :: res + + string = "bcd" + res = lle(string, "abc") + call check(res .eqv. .false.) + + res = lle(string, "bcd") + call check(res .eqv. .true.) + + res = lle(string, "cde") + call check(res .eqv. .true.) + end subroutine test_lle + + subroutine test_trim + type(string_type) :: string, trimmed_str + + string = "Whitespace " + trimmed_str = trim(string) + call check(len(trimmed_str) == 10) + end subroutine test_trim + + subroutine test_len + type(string_type) :: string + integer :: length + + string = "Some longer sentence for this example." + length = len(string) + call check(length == 38) + + string = "Whitespace " + length = len(string) + call check(length == 38) + end subroutine test_len + + subroutine test_len_trim + type(string_type) :: string + integer :: length + + string = "Some longer sentence for this example." + length = len_trim(string) + call check(length == 38) + + string = "Whitespace " + length = len_trim(string) + call check(length == 10) + end subroutine test_len_trim + + subroutine test_adjustl + type(string_type) :: string + + string = " Whitespace" + string = adjustl(string) + call check(char(string) == "Whitespace ") + end subroutine test_adjustl + + subroutine test_adjustr + type(string_type) :: string + + string = "Whitespace " + string = adjustr(string) + call check(char(string) == " Whitespace") + end subroutine test_adjustr + + subroutine test_scan + type(string_type) :: string + integer :: pos + + string = "fortran" + pos = scan(string, "ao") + call check(pos == 2) + + pos = scan(string, "ao", .true.) + call check(pos == 6) + + pos = scan(string, "c++") + call check(pos == 0) + end subroutine test_scan + + subroutine test_verify + type(string_type) :: string + integer :: pos + + string = "fortran" + pos = verify(string, "ao") + call check(pos == 1) + + pos = verify(string, "fo") + call check(pos == 3) + + pos = verify(string, "c++") + call check(pos == 1) + + pos = verify(string, "c++", back=.true.) + call check(pos == 7) + + pos = verify(string, string) + call check(pos == 0) + end subroutine test_verify + + subroutine test_repeat + type(string_type) :: string + + string = "What? " + string = repeat(string, 3) + call check(string == "What? What? What? ") + end subroutine test_repeat + + subroutine test_index + type(string_type) :: string + integer :: pos + + string = "Search this string for this expression" + pos = index(string, "this") + call check(pos == 8) + + pos = index(string, "this", back=.true.) + call check(pos == 24) + + pos = index(string, "This") + call check(pos == 0) + end subroutine test_index + + subroutine test_char + type(string_type) :: string + character(len=:), allocatable :: dlc + character(len=1), allocatable :: chars(:) + + string = "Character sequence" + dlc = char(string) + call check(dlc == "Character sequence") + + dlc = char(string, 3) + call check(dlc == "a") + chars = char(string, [3, 5, 8, 12, 14, 15, 18]) + call check(all(chars == ["a", "a", "e", "e", "u", "e", "e"])) + + string = "Fortran" + dlc = char(string, 1, 4) + call check(dlc == "Fort") + end subroutine test_char + + subroutine test_ichar + type(string_type) :: string + integer :: code + + string = "Fortran" + code = ichar(string) + call check(code == ichar("F")) + end subroutine test_ichar + + subroutine test_iachar + type(string_type) :: string + integer :: code + + string = "Fortran" + code = iachar(string) + call check(code == iachar("F")) + end subroutine test_iachar + +end module test_string_intrinsic + +program tester + use test_string_intrinsic + implicit none + + call test_lgt + call test_llt + call test_lge + call test_lle + call test_trim + call test_len + call test_len_trim + call test_adjustl + call test_adjustr + call test_scan + call test_verify + call test_repeat + call test_index + call test_char + call test_ichar + call test_iachar + +end program tester + diff --git a/src/tests/string/test_string_operator.f90 b/src/tests/string/test_string_operator.f90 new file mode 100644 index 000000000..365c15ca3 --- /dev/null +++ b/src/tests/string/test_string_operator.f90 @@ -0,0 +1,123 @@ +! SPDX-Identifer: MIT +module test_string_operator + use stdlib_error, only : check + use stdlib_string_type, only : string_type, assignment(=), len, & + operator(.gt.), operator(.lt.), operator(.ge.), operator(.le.), & + operator(.ne.), operator(.eq.), operator(//) + implicit none + +contains + + subroutine test_gt + type(string_type) :: string + logical :: res + + string = "bcd" + res = string > "abc" + call check(res .eqv. .true.) + + res = string > "bcd" + call check(res .eqv. .false.) + + res = string > "cde" + call check(res .eqv. .false.) + end subroutine test_gt + + subroutine test_lt + type(string_type) :: string + logical :: res + + string = "bcd" + res = string < "abc" + call check(res .eqv. .false.) + + res = string < "bcd" + call check(res .eqv. .false.) + + res = string < "cde" + call check(res .eqv. .true.) + end subroutine test_lt + + subroutine test_ge + type(string_type) :: string + logical :: res + + string = "bcd" + res = string >= "abc" + call check(res .eqv. .true.) + + res = string >= "bcd" + call check(res .eqv. .true.) + + res = string >= "cde" + call check(res .eqv. .false.) + end subroutine test_ge + + subroutine test_le + type(string_type) :: string + logical :: res + + string = "bcd" + res = string <= "abc" + call check(res .eqv. .false.) + + res = string <= "bcd" + call check(res .eqv. .true.) + + res = string <= "cde" + call check(res .eqv. .true.) + end subroutine test_le + + subroutine test_eq + type(string_type) :: string + logical :: res + + string = "bcd" + res = string == "abc" + call check(res .eqv. .false.) + + res = string == "bcd" + call check(res .eqv. .true.) + + res = string == "cde" + call check(res .eqv. .false.) + end subroutine test_eq + + subroutine test_ne + type(string_type) :: string + logical :: res + + string = "bcd" + res = string /= "abc" + call check(res .eqv. .true.) + + res = string /= "bcd" + call check(res .eqv. .false.) + + res = string /= "cde" + call check(res .eqv. .true.) + end subroutine test_ne + + subroutine test_concat + type(string_type) :: string + + string = "Hello, " + string = string // "World!" + call check(len(string) == 13) + end subroutine test_concat + +end module test_string_operator + +program tester + use test_string_operator + implicit none + + call test_gt + call test_lt + call test_ge + call test_le + call test_eq + call test_ne + call test_concat + +end program tester