fpm_strings Module

This module defines general procedures for string operations for both CHARACTER and TYPE(STRING_T) variables

general routines for performing string operations

Types

  • TYPE(STRING_T) define a type to contain strings of variable length

Type Conversions

  • f_string return Fortran CHARACTER variable when given a C-like array of single characters terminated with a C_NULL_CHAR CHARACTER
  • str Converts INTEGER or LOGICAL to CHARACTER string

Case

  • lower Changes a string to lowercase over optional specified column range

Parsing and joining

  • split parse string on delimiter characters and store tokens into an allocatable array
  • string_cat Concatenate an array of type(string_t) into a single CHARACTER variable
  • join append an array of CHARACTER variables into a single CHARACTER variable

Testing

  • str_ends_with test if a CHARACTER string or array ends with a specified suffix
  • string_array_contains Check if array of TYPE(STRING_T) matches a particular CHARACTER string
  • OPERATOR(.IN.) Check if array of TYPE(STRING_T) matches a particular CHARACTER string
  • glob function compares text strings, one of which can have wildcards (‘*’ or ‘?’).
  • is_fortran_name determine whether a string is an acceptable Fortran entity name
  • to_fortran_name replace allowed special but unusuable characters in names with underscore

Whitespace

  • notabs Expand tab characters assuming a tab space every eight characters
  • len_trim Determine total trimmed length of STRING_T array

Miscellaneous

  • fnv_1a Hash a CHARACTER(*) string of default kind or a TYPE(STRING_T) array
  • replace Returns string with characters in charset replaced with target_char.
  • resize increase the size of a TYPE(STRING_T) array by N elements

Module naming



Contents


Interfaces

public interface fnv_1a

  • private pure function fnv_1a_char(input, seed) result(hash)

    Hash a character(*) string of default kind

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: input
    integer(kind=int64), intent(in), optional :: seed

    Return Value integer(kind=int64)

  • private pure function fnv_1a_string_t(input, seed) result(hash)

    Hash a string_t array of default kind

    Arguments

    Type IntentOptional Attributes Name
    type(string_t), intent(in) :: input(:)
    integer(kind=int64), intent(in), optional :: seed

    Return Value integer(kind=int64)

public interface len_trim

  • private elemental function string_len_trim(string) result(n)

    Determine total trimmed length of string_t array

    Arguments

    Type IntentOptional Attributes Name
    type(string_t), intent(in) :: string

    Return Value integer

  • private pure function strings_len_trim(strings) result(n)

    Determine total trimmed length of string_t array

    Arguments

    Type IntentOptional Attributes Name
    type(string_t), intent(in) :: strings(:)

    Return Value integer

public interface operator(.in.)

  • public function string_array_contains(search_string, array)

    Check if array of TYPE(STRING_T) matches a particular CHARACTER string

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: search_string
    type(string_t), intent(in) :: array(:)

    Return Value logical

public interface resize

  • private subroutine resize_string(list, n)

    increase the size of a TYPE(STRING_T) array by N elements

    Arguments

    Type IntentOptional Attributes Name
    type(string_t), intent(inout), allocatable :: list(:)

    Instance of the array to be resized

    integer, intent(in), optional :: n

    Dimension of the final array size

public interface str

  • private pure function str_int(i) result(s)

    Converts integer “i” to string

    Arguments

    Type IntentOptional Attributes Name
    integer, intent(in) :: i

    Return Value character(len=str_int_len)

  • private pure function str_int64(i) result(s)

    Converts integer “i” to string

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int64), intent(in) :: i

    Return Value character(len=str_int64_len)

  • private pure function str_logical(l) result(s)

    Converts logical “l” to string

    Arguments

    Type IntentOptional Attributes Name
    logical, intent(in) :: l

    Return Value character(len=str_logical_len)

public interface str_ends_with

  • private pure function str_ends_with_str(s, e) result(r)

    test if a CHARACTER string ends with a specified suffix

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: s
    character(len=*), intent(in) :: e

    Return Value logical

  • private pure function str_ends_with_any(s, e) result(r)

    test if a CHARACTER string ends with any of an array of suffixs

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: s
    character(len=*), intent(in) :: e(:)

    Return Value logical

public interface string_t

  • private function new_string_t(s) result(string)

    Helper function to generate a new string_t instance (Required due to the allocatable component)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: s

    Return Value type(string_t)


Derived Types

type, public ::  string_t

Components

Type Visibility Attributes Name Initial
character(len=:), public, allocatable :: s

Constructor

private function new_string_t (s)

Helper function to generate a new string_t instance (Required due to the allocatable component)


Functions

public function f_string(c_string)

return Fortran character variable when given a C-like array of single characters terminated with a C_NULL_CHAR character

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: c_string(:)

Return Value character(len=:), allocatable

public function glob(tame, wild)

glob(3f) compares given STRING for match to PATTERN which may contain wildcard characters.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*) :: tame

A string without wildcards to compare to the globbing expression

character(len=*) :: wild

A (potentially) corresponding string with wildcards

Return Value logical

result of test

public function has_valid_custom_prefix(module_name, custom_prefix) result(valid)

Check that a module name is prefixed with a custom prefix: 1) It must be a valid FORTRAN name subset (<=63 chars, begin with letter, only alphanumeric allowed) 2) It must begin with the prefix 3) If longer, package name must be followed by default separator (“_”) plus at least one char

Read more…

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: module_name
type(string_t), intent(in) :: custom_prefix

Return Value logical

public function has_valid_standard_prefix(module_name, package_name) result(valid)

Check that a module name is prefixed with the default package prefix: 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, “_” is only allowed non-alphanumeric) 2) It must begin with the package name 3) If longer, package name must be followed by default separator plus at least one char

Read more…

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: module_name
type(string_t), intent(in) :: package_name

Return Value logical

public function is_fortran_name(line) result(lout)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line

Return Value logical

public function is_valid_module_name(module_name, package_name, custom_prefix, enforce_module_names) result(valid)

Check that a module name fits the current naming rules: 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, “_” is only allowed non-alphanumeric) 2) It must begin with the package name 3) If longer, package name must be followed by default separator plus at least one char

Read more…

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: module_name
type(string_t), intent(in) :: package_name
type(string_t), intent(in) :: custom_prefix
logical, intent(in) :: enforce_module_names

Return Value logical

public function is_valid_module_prefix(module_prefix) result(valid)

Check that a custom module prefix fits the current naming rules: 1) Only alphanumeric characters (no spaces, dashes, underscores or other characters) 2) Does not begin with a number (Fortran-compatible syntax)

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: module_prefix

Return Value logical

public pure function join(str, sep, trm, left, right, start, end) result(string)

Author
John S. Urban
License
Public Domain

JOIN(3f) appends the elements of a CHARACTER array into a single CHARACTER variable, with elements 1 to N joined from left to right. By default each element is trimmed of trailing spaces and the default separator is a null string.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str(:)
character(len=*), intent(in), optional :: sep
logical, intent(in), optional :: trm
character(len=*), intent(in), optional :: left
character(len=*), intent(in), optional :: right
character(len=*), intent(in), optional :: start
character(len=*), intent(in), optional :: end

Return Value character(len=:), allocatable

public pure elemental function lower(str, begin, end) result(string)

Author
John S. Urban
License
Public Domain

Changes a string to lowercase over optional specified column range

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
integer, intent(in), optional :: begin
integer, intent(in), optional :: end

Return Value character(len=len(str))

public function module_prefix_template(project_name, custom_prefix) result(prefix)

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: project_name
type(string_t), intent(in) :: custom_prefix

Return Value type(string_t)

public function module_prefix_type(project_name, custom_prefix) result(ptype)

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: project_name
type(string_t), intent(in) :: custom_prefix

Return Value type(string_t)

public pure function replace(string, charset, target_char) result(res)

Returns string with characters in charset replaced with target_char.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string
character(len=1), intent(in) :: charset(:)
character(len=1), intent(in) :: target_char

Return Value character(len=len(string))

public pure function str_begins_with_str(s, e, case_sensitive) result(r)

test if a CHARACTER string begins with a specified prefix

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: s
character(len=*), intent(in) :: e
logical, intent(in), optional :: case_sensitive

Return Value logical

public function string_array_contains(search_string, array)

Check if array of TYPE(STRING_T) matches a particular CHARACTER string

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: search_string
type(string_t), intent(in) :: array(:)

Return Value logical

public function string_cat(strings, delim) result(cat)

Concatenate an array of type(string_t) into a single CHARACTER variable

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: strings(:)
character(len=*), intent(in), optional :: delim

Return Value character(len=:), allocatable

public pure function to_fortran_name(string) result(res)

Returns string with special characters replaced with an underscore. For now, only a hyphen is treated as a special character, but this can be expanded to other characters if needed.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

Return Value character(len=len(string))


Subroutines

public impure elemental subroutine notabs(instr, outstr, ilen)

notabs(3f) - [fpm_strings:NONALPHA] expand tab characters (LICENSE:PD)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: instr
character(len=*), intent(out) :: outstr
integer, intent(out) :: ilen

public subroutine remove_newline_characters(string)

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(inout) :: string

public subroutine split(input_line, array, delimiters, order, nulls)

Author
John S. Urban
License
Public Domain

parse string on delimiter characters and store tokens into an allocatable array given a line of structure ” par1 par2 par3 … parn ” store each par(n) into a separate variable in array.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: input_line

input string to tokenize

character(len=:), intent(out), allocatable :: array(:)

output array of tokens

character(len=*), intent(in), optional :: delimiters

list of delimiter characters

character(len=*), intent(in), optional :: order

order of output array sequential|[reverse|right]

character(len=*), intent(in), optional :: nulls

return strings composed of delimiters or not ignore|return|ignoreend