string.f90

Go to the documentation of this file.

!> @file
!! @defgroup group_string String
!! Minimal yet powerful variable-length string type with modern Fortran features.
!! This module implements a lightweight `string` derived type that behaves like
!! a true variable-length character string while remaining fully compatible with
!! intrinsic Fortran character operations.
!!
!! Features:
!! - Automatic memory management via `allocatable character(:)`
!! - Overloaded assignment (`=`) between `string` and `character(*)`
!! - Overloaded operators: `//` (concatenation), `==` (equality), `.contains.` (membership)
!! - Generic interfaces for `len`, `len_trim`, `trim`
!! - Full support for formatted I/O (`write`, `print`)
!! - Helper routines for parsing Fortran source (line continuation, upper/lower case conversion, etc.)
!!
!! The design is intentionally minimal - it provides only what's necessary for
!! robust string handling in scientific and preprocessing applications,
!! avoiding the bloat of larger string libraries while remaining fast and standards-compliant.
!! @note All procedures are `pure` or `elemental` when possible for maximum performance
!!       and usability in array contexts.
!!
!! @section string_examples Examples
!!
!! @par Basic Usage
!! @code{.f90}
!! type(string) :: s, t
!! character(:), allocatable :: line
!!
!! s = 'Hello'              ! Assignment from literal
!! t = s // ' World!'       ! Concatenation
!! print *, t%chars         ! Output: Hello World!
!!
!! if (s == 'Hello') then
!!      print *, 'Equal'
!! else
!!      print *, 'Case sensitive'
!! endif
!!
!! print *, len(t)          ! -> 12
!! print *, len_trim(t)     ! -> 12
!! ...
!! @endcode
!!
!! @par Array and Container Support
!! @code{.f90}
!! type(string) :: words(3)
!! logical      :: found
!!
!! words = [string('apple'), string('banana'), string('cherry')]
!! found = words .contains. 'banana'     ! --> .true.
!! found = words .contains. string('date') ! --> .false.
!! ...
!! @endcode
!!
!! @par Advanced: Source Code Processing
!! @code{.f90}
!! character(len=:), allocatable :: code_line
!! code_line = uppercase('program hello_world  ! comment')  ! --> 'PROGRAM HELLO_WORLD  ! comment'
!! ...
!! @endcode
module fpx_string
    use fpx_constants
 
    implicit none; private
 
    public :: len,          &
            len_trim,     &
            trim,         &
            operator(//), &
            operator(.contains.), &
            index
 
    public :: starts_with,  &
            head,         &
            tail,         &
            previous,     &
            concat,       &
            writechk,     &
            uppercase,    &
            lowercase
 
    !> Represents text as a sequence of ASCII code units.
    !!        The derived type wraps an allocatable character array.
    !!
    !! @section string_type_examples Examples
    !!
    !! @code{.f90}
    !! type(string) :: s
    !! s = 'foo'
    !! @endcode
    !!
    !! @section string_type_constructor Constructors
    !! Initializes a new instance of the string class
    !! <h3>string(character(:))</h3>
    !! @verbatim type(string) function string(chars) @endverbatim
    !!
    !! @param[in] chars character(:)
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(string) :: s
    !! s = string('foo')
    !! @endcode
    !! @return The constructed string object.
    !!
    !! @section string_type_remarks Remarks
    !! The string implementation proposed here is kept at the bare
    !! minimum of what is required by the library. There are many
    !! other implementations that can be found.
    !!
    !! @ingroup group_string
    type, public :: string
        character(:), allocatable :: chars  !< Variable length character array
    contains
        !! @cond
        procedure, pass(lhs), private    :: character_assign_string
        procedure, pass(rhs), private    :: string_assign_character
        procedure, pass(lhs), private    :: string_eq_string  !! Equal to string logical operator.
        procedure, pass(lhs), private    :: string_eq_character  !! Equal to character logical operator.
        procedure, pass(rhs), private    :: character_eq_string  !! Equal to character (inverted) logical operator.
        procedure, pass(dtv), private    :: write_formatted  !! Formatted output.
        !! @endcond
        generic, public :: assignment(=) => character_assign_string, &
                string_assign_character
        generic, public :: operator(==) => string_eq_string, &
                string_eq_character, &
                character_eq_string
        generic, public :: write(formatted) => write_formatted
    end type
 
    !> Return the length of a @ref string object.
    !!
    !! This generic interface extends the intrinsic Fortran `len` function
    !! to support the fpx @ref string type.
    !!
    !! The returned value corresponds to the full length of the underlying
    !! character storage, including trailing blanks.
    !!
    !! If the string is not allocated, the returned value is zero.
    !!
    !! @section len_examples Examples
    !!
    !! Basic usage:
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! s = 'foo'
    !! print *, len(s)          ! 3
    !!
    !! s = 'foo '
    !! print *, len(s)          ! 4
    !! ...
    !! @endcode
    !!
    !! Unallocated strings:
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! print *, len(s)          ! 0
    !! ...
    !! @endcode
    !!
    !! @ingroup group_string
    interface len
        module procedure :: string_len
    end interface
 
    !> Return the trimmed length of a @ref string object.
    !!
    !! This generic interface extends the intrinsic Fortran `len_trim`
    !! function to support the fpx @ref string type.
    !!
    !! The returned value corresponds to the number of characters after
    !! removing trailing blanks.
    !!
    !! If the string is not allocated, the returned value is zero.
    !!
    !! @section len_trim_examples Examples
    !!
    !! Basic usage:
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! s = 'foo'
    !! print *, len_trim(s)     ! 3
    !!
    !! s = 'foo '
    !! print *, len_trim(s)     ! 3
    !! ...
    !! @endcode
    !!
    !! Unallocated strings:
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! print *, len_trim(s)     ! 0
    !! ...
    !! @endcode
    !!
    !! @ingroup group_string
    interface len_trim
        module procedure :: string_len_trim
    end interface
 
    !> Remove trailing blanks from a @ref string object.
    !!
    !! This generic interface extends the intrinsic Fortran `trim`
    !! function to support the fpx @ref string type.
    !!
    !! The result is returned as a deferred-length intrinsic character
    !! expression with trailing blanks removed.
    !!
    !! If the string is not allocated, an empty character string is returned.
    !!
    !! @section trim_examples Examples
    !!
    !! Basic usage:
    !! @code{.f90}
    !! type(string) :: s
    !! character(:), allocatable :: c
    !!
    !! s = 'hello   '
    !!
    !! c = trim(s)
    !! print *, '"' // c // '"'      ! "hello"
    !! ...
    !! @endcode
    !!
    !! Unallocated strings:
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! print *, len(trim(s))         ! 0
    !! ...
    !! @endcode
    !!
    !! @return Deferred-length character string without trailing blanks.
    !!
    !! @ingroup group_string
    interface trim
        module procedure :: string_trim
    end interface
 
    !> Concatenate string and character expressions.
    !!
    !! Supports all combinations of:
    !! - string // string
    !! - string // character(*)
    !! - character(*) // string
    !!
    !! The result is returned as a deferred-length character expression.
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! s = 'foo'
    !!
    !! print *, s // 'bar'
    !! print *, '>>' // s
    !! ...
    !! @endcode
    !!
    !! @ingroup group_string
    interface operator(//)
        module procedure :: string_concat_string
        module procedure :: string_concat_character
        module procedure :: character_concat_string
    end interface
 
    !> Test whether a value is present in an array.
    !!
    !! The `.contains.` operator provides convenient membership testing
    !! between arrays of intrinsic characters and arrays of @ref string
    !! objects.
    !!
    !! Supported combinations are:
    !! - `string(:) .contains. string`
    !! - `string(:) .contains. character(*)`
    !! - `character(:) .contains. string`
    !! - `character(:) .contains. character(*)`
    !!
    !! The comparison uses the overloaded equality operator (`==`)
    !! associated with the involved types.
    !!
    !! @section contains_examples Examples
    !!
    !! Arrays of string:
    !! @code{.f90}
    !! type(string) :: fruits(3)
    !!
    !! fruits = [ string('apple'), &
    !!            string('banana'), &
    !!            string('cherry') ]
    !!
    !! print *, fruits .contains. 'banana'      ! .true.
    !! print *, fruits .contains. 'orange'      ! .false.
    !! ...
    !! @endcode
    !!
    !! Mixed character/string usage:
    !! @code{.f90}
    !! character(10) :: names(2)
    !!
    !! names = ['foo       ', 'bar       ']
    !!
    !! print *, names .contains. string('foo')  ! .true.
    !! ...
    !! @endcode
    !!
    !! Empty arrays:
    !! @code{.f90}
    !! type(string) :: values(0)
    !!
    !! print *, values .contains. 'x'           ! .false.
    !! ...
    !! @endcode
    !!
    !! @return `.true.` if the searched value is present,
    !!         `.false.` otherwise.
    !!
    !! @ingroup group_string
    interface operator(.contains.)
        module procedure :: strings_contain_string
        module procedure :: strings_contain_character
        module procedure :: characters_contain_string
        module procedure :: characters_contain_character
    end interface
 
    !> Locate the position of a substring.
    !!
    !! This generic interface extends the intrinsic Fortran `index`
    !! function to support the fpx @ref string type.
    !!
    !! Supported combinations are:
    !! - `index(string, string)`
    !! - `index(string, character(*))`
    !! - `index(character(*), string)`
    !!
    !! The optional argument `back` behaves exactly as in the intrinsic
    !! Fortran procedure:
    !! - if absent or `.false.`, the first occurrence is returned;
    !! - if `.true.`, the last occurrence is returned.
    !!
    !! The function returns zero if the substring is not found.
    !!
    !! @section index_examples Examples
    !!
    !! String and character:
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! s = 'banana'
    !!
    !! print *, index(s, 'na')               ! 3
    !! print *, index(s, 'xy')               ! 0
    !! ...
    !! @endcode
    !!
    !! String and string:
    !! @code{.f90}
    !! type(string) :: text
    !! type(string) :: sub
    !!
    !! text = 'banana'
    !! sub  = 'na'
    !!
    !! print *, index(text, sub)             ! 3
    !! ...
    !! @endcode
    !!
    !! Search from the end:
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! s = 'banana'
    !!
    !! print *, index(s, 'na', back=.true.)  ! 5
    !! ...
    !! @endcode
    !!
    !! Mixed usage:
    !! @code{.f90}
    !! type(string) :: sub
    !!
    !! sub = 'ana'
    !!
    !! print *, index('banana', sub)         ! 2
    !! ...
    !! @endcode
    !!
    !! @return Position of the matching substring, or zero if not found.
    !!
    !! @ingroup group_string
    interface index
        module procedure :: index_string_string
        module procedure :: index_string_character
        module procedure :: index_character_string
    end interface
 
contains
 
    !> Assignment overloading. Assign a character array to a string.
    !! @param[inout] lhs string
    !! @param[in]    rhs character(*)
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(string) :: s
    !!
    !! s = 'foo'
    !! @endcode
    !!
    !! @ingroup group_string
    subroutine character_assign_string(lhs, rhs)
        class(string), intent(inout)   :: lhs
        character(*), intent(in)       :: rhs
 
        if (allocated(lhs%chars)) deallocate(lhs%chars)
        allocate(lhs%chars, source=rhs)
    end subroutine
 
    !> Assignment overloading. Assign a string to a character array.
    !! @param[inout] lhs character(:), allocatable
    !! @param[in]    rhs string
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(string) :: s
    !! character(:), allocatable :: c
    !!
    !! s = 'foo'
    !! c = s
    !! ! The value of c is now 'foo'
    !! @endcode
    !!
    !! @ingroup group_string
    subroutine string_assign_character(lhs, rhs)
        character(:), allocatable, intent(inout) :: lhs
        class(string), intent(in)                :: rhs
 
        lhs = rhs%chars
    end subroutine
 
    !> Length of the string entity.
    !! @param[in] this string
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(string) :: s
    !! integer :: l
    !!
    !! s = string('foo ')
    !! l = len(s)
    !! ! The value of l is 4
    !! @endcode
    !! @return An integer corresponding to the length of the string.
    !!
    !! @ingroup group_string
    elemental integer function string_len(this) result(res)
        class(string), intent(in) :: this
 
        if (allocated(this%chars)) then
            res = len(this%chars)
        else
            res = 0
        end if
    end function
 
    !> Length of the string entity without trailing blanks (len_trim).
    !! @param[in] this string
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(string) :: s
    !! integer :: l
    !!
    !! s = string('foo ')
    !! l = len_trim(s)
    !! ! The value of l is 3
    !! @endcode
    !! @return An integer corresponding to the trimmed length of the string.
    !!
    !! @ingroup group_string
    pure integer function string_len_trim(this) result(res)
        class(string), intent(in) :: this
 
        if (allocated(this%chars)) then
            res = len_trim(this%chars)
        else
            res = 0
        end if
    end function
 
    !> Returns a copy of the string with trailing blanks removed.
    !! @param[in] this string
    !! @return Trimmed character string (deferred length).
    !!
    !! @ingroup group_string
    pure function string_trim(this) result(res)
        class(string), intent(in) :: this
        character(:), allocatable :: res
 
        if (allocated(this%chars)) then
            res = trim(this%chars)
        else
            res = ''
        end if
    end function
 
    !> Concatenation of two string objects.
    !! @param[in] lhs left-hand side string
    !! @param[in] rhs right-hand side string
    !! @return New concatenated string.
    !!
    !! @ingroup group_string
    pure function string_concat_string(lhs, rhs) result(res)
        class(string), intent(in) :: lhs
        class(string), intent(in) :: rhs
        character(:), allocatable :: res
 
        if (allocated(lhs%chars) .and. allocated(rhs%chars)) then
            res = lhs%chars // rhs%chars
        elseif (allocated(lhs%chars)) then
            res = lhs%chars
        elseif (allocated(rhs%chars)) then
            res = rhs%chars
        else
            res = ''
        end if
    end function
 
    !> Concatenation of string and character expression.
    !! @param[in] lhs string
    !! @param[in] rhs character expression
    !! @return New concatenated string.
    !!
    !! @ingroup group_string
    pure function string_concat_character(lhs, rhs) result(res)
        class(string), intent(in)   :: lhs
        character(*), intent(in)    :: rhs
        character(:), allocatable   :: res
 
        if (allocated(lhs%chars)) then
            res = lhs%chars // rhs
        else
            res = rhs
        end if
    end function
 
    !> Concatenation of character expression and string.
    !! @param[in] lhs character expression
    !! @param[in] rhs string
    !! @return New concatenated string.
    !!
    !! @ingroup group_string
    pure function character_concat_string(lhs, rhs) result(res)
        character(*), intent(in)    :: lhs
        class(string), intent(in)   :: rhs
        character(:), allocatable   :: res
 
        if (allocated(rhs%chars)) then
            res = lhs // rhs%chars
        else
            res = lhs
        end if
    end function
 
    !> Equality comparison between two string objects.
    !! @param[in] lhs left-hand side
    !! @param[in] rhs right-hand side
    !! @return .true. if the strings are equal, .false. otherwise.
    !!
    !! @ingroup group_string
    elemental function string_eq_string(lhs, rhs) result(res)
        class(string), intent(in) :: lhs  !! Left hand side.
        class(string), intent(in) :: rhs  !! Right hand side.
        logical :: res
 
        if (.not. allocated(lhs%chars)) then
            res = .not. allocated(rhs%chars)
        else
            res = lhs%chars == rhs%chars
        end if
    end function
 
    !> Equality comparison between string and character expression.
    !! @param[in] lhs string
    !! @param[in] rhs character expression
    !! @return .true. if equal, .false. otherwise.
    !!
    !! @ingroup group_string
    elemental function string_eq_character(lhs, rhs) result(res)
        class(string), intent(in) :: lhs  !! Left hand side.
        character(*), intent(in) :: rhs  !! Right hand side.
        logical                               :: res  !! Opreator test result.
 
        if (.not. allocated(lhs%chars)) then
            res = .false.
        else
            res = lhs%chars == rhs
        end if
    end function
 
    !> Equality comparison (reversed) between character expression and string.
    !! @param[in] lhs character expression
    !! @param[in] rhs string
    !! @return .true. if equal, .false. otherwise.
    !!
    !! @ingroup group_string
    elemental function character_eq_string(lhs, rhs) result(res)
        character(*), intent(in) :: lhs  !! Left hand side.
        class(string), intent(in) :: rhs  !! Right hand side.
        logical                               :: res  !! Operator test result.
 
        if (.not. allocated(rhs%chars)) then
            res = .false.
        else
            res = rhs%chars == lhs
        end if
    end function
 
    !> Formatted output procedure for user-defined type @ref string (UDTIO)
    !! This procedure is called automatically when a formatted WRITE statement is used
    !! with a variable of type `string` (when using the DT edit descriptor or default
    !! formatted output for the type).
    !!
    !! It writes the content of the string component `dtv%chars` using a simple `A` format.
    !! If the string is not allocated, an empty string is written.
    !!
    !! @param[in] dtv       The @ref string object to be written (polymorphic dummy argument)
    !! @param[in] unit      Fortran logical unit number
    !! @param[in] iotype    String describing the edit descriptor ('DT' + optional string)
    !! @param[in] v_list    Integer array containing the values from the DT edit descriptor
    !!                      (v_list is empty if no parentheses were used after DT)
    !! @param[out] iostat   I/O status code (0 = success, positive = error, negative = end-of-file/end-of-record)
    !! @param[inout] iomsg  Message describing the I/O error (if any)
    !!
    !! @b Note
    !! - This implementation **ignores** `iotype` and `v_list` parameters
    !!   -> the same simple character output is always performed
    !! - The procedure always uses format `(A)`
    !! - Empty (not allocated) string is written as empty line (zero characters)
    !!
    !! @b Warning
    !! This is a minimal implementation of UDTIO formatted output.
    !! More sophisticated versions could:
    !! - respect `iotype` (DT"..." or LISTDIRECTED)
    !! - use `v_list` for width/precision control
    !! - add quotation marks, escaping, etc.
    !!
    !! @b Examples
    !! @code{.f90}
    !! type(string) :: s
    !! call s%set("Hello formatted world!")
    !!
    !! write(*, *)     s               ! may call write_formatted (depending on compiler)
    !! write(*, '(DT)') s              ! explicitly calls write_formatted
    !! @endcode
    !!
    !! @ingroup group_string
    ! allow(assumed-size-character-intent)
    subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
        class(string), intent(in)   :: dtv
        integer, intent(in)         :: unit  !! Logical unit.
        character(*), intent(in)    :: iotype  !! Edit descriptor.
        integer, intent(in)         :: v_list(:)  !! Edit descriptor list.
        integer, intent(out)        :: iostat  !! IO status code.
        character(*), intent(inout) :: iomsg  !! IO status message.
 
        if (allocated(dtv%chars)) then
            write(unit, '(A)', iostat=iostat, iomsg=iomsg) dtv%chars
        else
            write(unit, '(A)', iostat=iostat, iomsg=iomsg) ''
        end if
    end subroutine
 
    !> Checks if a string starts with a given prefix
    !! Returns `.true.` if the string `str` (after trimming leading/trailing whitespace)
    !! begins exactly with the substring `arg1`.
    !! The function uses `index()` after trimming both strings with `trim(adjustl())`.
    !!
    !! @param[in] str    The string to be tested
    !! @param[in] arg1   The prefix to look for at the beginning of `str`
    !! @param[out] idx  (optional) If present, receives the starting position of `arg1` in the trimmed string
    !!                       (will be 1 if the function returns `.true.`, otherwise >1 or 0)
    !!
    !! @return `.true.` if `str` starts with `arg1` (after trimming), `.false.` otherwise
    !!
    !! @b Note
    !! - Leading and trailing whitespace of both `str` and `arg1` is ignored
    !! - Comparison is case-sensitive
    !! - Empty `arg1` will always return `.true.` (any string starts with empty string)
    !!
    !! @b Warning
    !! The returned index (when requested) is the position **after trimming** of the input string,
    !! not in the original untrimmed string.
    !!
    !! @b Examples
    !! @code{.f90}
    !! character(80) :: line = '   hello world  '
    !! logical :: ok
    !! integer :: pos
    !!
    !! ok = starts_with(line, 'hello')               ! -> .true.
    !! ok = starts_with(line, 'hello', pos)          ! -> .true. and pos = 1
    !! ok = starts_with(line, 'world')               ! -> .false.
    !! ok = starts_with('  test123  ', 'test')       ! -> .true.
    !! ...
    !! @endcode
    !!
    !! @ingroup group_string
    !! @ingroup group_string
    logical function starts_with(str, arg1, idx) result(res)
        character(*), intent(in) :: str
        character(*), intent(in) :: arg1
        integer, intent(out), optional :: idx
        !private
        integer :: i
 
        i = index(trim(adjustl(str)), trim(arg1))
        res = (i == 1)
        if (present(idx)) idx = i
    end function
 
    !> Returns the first character of the trimmed string.
    !! @param[in] str input string
    !! @return First character (space if empty)
    !!
    !! @ingroup group_string
    character function head(str) result(res)
        character(*), intent(in) :: str
 
        res = ' '
        if (len_trim(str) == 0) return
 
        res = str(1:1)
    end function
 
    !> Returns the last non-blank character of a string.
    !! @param[in] str input string
    !! @return Last character (space if empty)
    !!
    !! @ingroup group_string
    character function tail(str) result(res)
        character(*), intent(in) :: str
        !private
        integer :: n
 
        res = ' '; n = len_trim(str)
        if (n == 0) return
 
        res = str(n:n)
    end function
 
    !> Smart concatenation that removes continuation markers (&) and handles line-continuation rules.
    !! @param[in] str1 first line
    !! @param[in] str2 second line
    !! @return Concatenated string with proper continuation handling
    !!
    !! @ingroup group_string
    function concat(str1, str2) result(res)
        character(*), intent(in) :: str1
        character(*), intent(in) :: str2
        character(:), allocatable :: res
        !private
        integer :: n1, n2
 
        n1 = len(str1); n2 = 1
        if (head(str1) == '!') then
            n2 = 2
            if (tail(str1) == '&') n1 = len_trim(str1) - 1
            if (starts_with(str2, '!dir$') .or. starts_with(str2, '!DIR$') .or. &
                    starts_with(str2, '!dec$') .or. starts_with(str2, '!DEC$') .or. &
                    starts_with(str2, '!gcc$') .or. starts_with(str2, '!GCC$') .or. &
                    starts_with(str2, '!acc$') .or. starts_with(str2, '!ACC$') .or. &
                    starts_with(str2, '!$omp') .or. starts_with(str2, '!$OMP')) then
                n2 = 6
            end if
            if (head(adjustl(str2(n2:))) == '&') then
                n2 = index(str2, '&') + 1
            end if
        else
            if (tail(str1) == '&') n1 = len_trim(str1) - 1
            if (head(trim(str2)) == '&') n2 = index(str2, '&') + 1
            if (tail(str1(:n1)) == '(') n1 = index(str1(:n1), '(', back=.true.)
        end if
 
        if (len(str1) > 0 .and. len(str2) >= n2) then
            if (str1(n1:n1) == ' ' .and. str2(n2:n2) == ' ') n2 = n2 + 1
        end if
        res = str1(:n1) // str2(n2:)
    end function
 
    !> Convert string to upper case (respects contents of quotes).
    !! @param[in] str input string
    !! @return Upper-case version of the string
    !!
    !! @b Examples
    !! @code
    !! character(*), parameter :: input = 'test'
    !! character(:), allocatable :: output
    !! output = uppercase(input)
    !! if (output == 'TEST') print*, 'OK'
    !! @endcode
    !!
    !! @ingroup group_string
    pure function uppercase(str) result(res)
        character(*), intent(in) :: str
        character(len_trim(str)) :: res
        !private
        integer :: ilen, ioffset, iquote, iqc, iav, i
 
        ilen = len_trim(str)
        ioffset = iachar('A') - iachar('a')
        iquote = 0
        res = str
        do i = 1, ilen
            iav = iachar(str(i:i))
            if (iquote == 0 .and. (iav == 34 .or. iav == 39)) then
                iquote = 1
                iqc = iav
                cycle
            end if
            if (iquote == 1 .and. iav == iqc) then
                iquote = 0
                cycle
            end if
            if (iquote == 1) cycle
            if (iav >= iachar('a') .and. iav <= iachar('z')) then
                res(i:i) = achar(iav + ioffset)
            else
                res(i:i) = str(i:i)
            end if
        end do
    end function
 
    !> Convert string to lower case (respects contents of quotes).
    !! @param[in] str input string
    !! @return Lower-case version of the string
    !!
    !! @b Examples
    !! @code
    !! character(*), parameter :: input = 'TEST'
    !! character(:), allocatable :: output
    !! output = lowercase(input)
    !! if (output == 'test') print*, 'OK'
    !! @endcode
    !!
    !! @ingroup group_string
    pure function lowercase(str) result(res)
        character(*), intent(in) :: str
        character(len_trim(str)) :: res
        !private
        integer :: ilen, ioffset, iquote, iqc, iav, i
 
        ilen = len_trim(str)
        ioffset = iachar('A') - iachar('a')
        iquote = 0
        res = str
        do i = 1, ilen
            iav = iachar(str(i:i))
            if (iquote == 0 .and. (iav == 34 .or. iav == 39)) then
                iquote = 1
                iqc = iav
                cycle
            end if
            if (iquote == 1 .and. iav == iqc) then
                iquote = 0
                cycle
            end if
            if (iquote == 1) cycle
            if (iav >= iachar('A') .and. iav <= iachar('Z')) then
                res(i:i) = achar(iav - ioffset)
            else
                res(i:i) = str(i:i)
            end if
        end do
    end function
 
    !> Write a long line split into chunks of size CHKSIZE with continuation (&).
    !! @param[in] unit logical unit
    !! @param[in] str  string to write
    !!
    !! @ingroup group_string
    subroutine writechk(unit, str)
        integer, intent(in)         :: unit
        character(*), intent(in)    :: str
        !private
        integer :: i, n
 
        n = 0
        if (head(str) /= '!') then
            n = floor(len(str) / real(chksize))
            do i = 1, n
                write(unit, '(A)') str((i - 1) * chksize + 1:i * chksize) // '&'
            end do
        end if
        write(unit, '(A)') str(n * chksize + 1:)
    end subroutine
 
    !> Returns the previous non-blank character before position pos (updates pos).
    !! @param[in]    line input line
    !! @param[inout] pos  current position (moved backward)
    !! @return Previous non-blank character
    !!
    !! @ingroup group_string
    character(1) function previous(line, pos) result(res)
        character(*), intent(in)    :: line
        integer, intent(inout)      :: pos
        !private
 
        if (pos == 1) then
            res = trim(line(pos:pos))
        else
            do while (line(pos:pos) == ' ')
                pos = pos - 1
                if (pos == 1) exit
            end do
            res = line(pos:pos)
        end if
    end function
 
    !> Checks whether an array of string contains a given string.
    !! @param[in] lhs array of string
    !! @param[in] rhs string to search for
    !! @return .true. if rhs is present in lhs
    !!
    !! @ingroup group_string
    logical function strings_contain_string(lhs, rhs) result(res)
        type(string), intent(in)    :: lhs(:)
        type(string), intent(in)    :: rhs
        !private
        integer :: i
 
        res = .false.
        do i = 1, size(lhs)
            if (lhs(i) == rhs) then
                res = .true.
                exit
            end if
        end do
    end function
 
    !> Checks whether an array of string contains a given character expression.
    !! @param[in] lhs array of string
    !! @param[in] rhs character expression to search for
    !! @return .true. if rhs is present in lhs
    !!
    !! @ingroup group_string
    logical function strings_contain_character(lhs, rhs) result(res)
        type(string), intent(in)    :: lhs(:)
        character(*), intent(in)    :: rhs
        !private
        integer :: i
 
        res = .false.
        do i = 1, size(lhs)
            if (lhs(i) == rhs) then
                res = .true.
                exit
            end if
        end do
    end function
 
    !> Checks whether an array of character contains a given character expression.
    !! @param[in] lhs array of character
    !! @param[in] rhs character expression to search for
    !! @return .true. if rhs is present in lhs
    !!
    !! @ingroup group_string
    logical function characters_contain_character(lhs, rhs) result(res)
        character(*), intent(in)    :: lhs(:)
        character(*), intent(in)    :: rhs
        !private
        integer :: i
 
        res = .false.
        do i = 1, size(lhs)
            if (lhs(i) == rhs) then
                res = .true.
                exit
            end if
        end do
    end function
 
    !> Checks whether an array of character contains a given string.
    !! @param[in] lhs array of character
    !! @param[in] rhs string to search for
    !! @return .true. if rhs is present in lhs
    !!
    !! @ingroup group_string
    logical function characters_contain_string(lhs, rhs) result(res)
        character(*), intent(in)    :: lhs(:)
        type(string), intent(in)    :: rhs
        !private
        integer :: i
 
        res = .false.
        do i = 1, size(lhs)
            if (lhs(i) == rhs) then
                res = .true.
                exit
            end if
        end do
    end function
 
    integer function index_string_string(str, substr, back) result(res)
        class(string), intent(in)           :: str
        class(string), intent(in)           :: substr
        logical, intent(in), optional       :: back
 
        res = index(str%chars, substr%chars, back=back)
    end function
 
    integer function index_character_string(str, substr, back) result(res)
        character(*), intent(in)            :: str
        class(string), intent(in)           :: substr
        logical, intent(in), optional       :: back
 
        res = index(str, substr%chars, back=back)
    end function
 
    integer function index_string_character(str, substr, back) result(res)
        class(string), intent(in)           :: str
        character(*), intent(in)            :: substr
        logical, intent(in), optional       :: back
 
        res = index(str%chars, substr, back=back)
    end function
 
end module