From 263a6524b432dd9573d6c5aab2112ac22f5a3799 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Wed, 3 Feb 2021 21:39:34 +0100 Subject: [PATCH 1/2] Add module for list of strings The API for the module to manipulate lists of strings has been discussed and this has resulted in the current implementation --- doc/specs/stdlib_stringlist.md | 487 +++++++++ src/stdlib_stringlist.f90 | 996 +++++++++++++++++++ src/tests/stringlist/CMakeLists.txt | 4 + src/tests/stringlist/test_delete.f90 | 57 ++ src/tests/stringlist/test_find.f90 | 72 ++ src/tests/stringlist/test_insert.f90 | 91 ++ src/tests/stringlist/test_replace_append.f90 | 88 ++ 7 files changed, 1795 insertions(+) create mode 100644 doc/specs/stdlib_stringlist.md create mode 100644 src/stdlib_stringlist.f90 create mode 100644 src/tests/stringlist/CMakeLists.txt create mode 100644 src/tests/stringlist/test_delete.f90 create mode 100644 src/tests/stringlist/test_find.f90 create mode 100644 src/tests/stringlist/test_insert.f90 create mode 100644 src/tests/stringlist/test_replace_append.f90 diff --git a/doc/specs/stdlib_stringlist.md b/doc/specs/stdlib_stringlist.md new file mode 100644 index 000000000..a214ce565 --- /dev/null +++ b/doc/specs/stdlib_stringlist.md @@ -0,0 +1,487 @@ +--- +title: stringlist +--- +# Lists of strings + +[TOC] + +## Introduction + +Fortran has supported variable-length strings since the 2003 standard, +but it does not have a native type to handle collections of strings of +different lengths. Such collections are quite useful though and the +language allows us to define a derived type that can handle such +collections. + +The `stdlib_stringlist` module defines a derived type that is capable of +storing a list of strings and of manipulating them. + +Methods include: + +* inserting strings at a given position +* replacing strings at a given position +* deleting a single string or a range of strings +* retrieving a string or a range of strings at a given position +* finding the position of a particular string or a string which contains some substring +* sorting the list + +## Positions in a list of strings + +The module implements what are effectively infinitely long lists: a position is +represented as a positive integer, but there is no "out-of-bound" index. That is, +the following piece of code will simply work: + +```fortran +type(stringlist_type) :: list + +! Add two strings ... +call list%insert( list_head, "The first string" ) +call list%insert( 20, "The last string" ) + +write(*,*) 'The last: ', list%get(list_end) +write(*,*) 'Beyond that: ', list%get(30) +``` +The special position `list_head` represents *the first element*, though a value +of 1 is equivalent. Likewise, the special position `list_end` represents the position +of the *last* element and the position `list_after_end` the position directly after +the last element. You can use these positions to insert a string before the current +first string that is already in the list or to insert after the last string that +has been inserted. + +If you specify a position beyond the last, the `list%get()` method simply returns an empty +string. The same holds for *zero* or *negative* indices. + +For inserting one or more elements, a *zero* or *negative* index is interpreted to mean the first, +an index beyond the last as the one *after* the last - this means effectively that the element is appended. + +If you do: + +```fortran +call list%insert( 1, 'The first string' ) +call list%insert( -10, 'A new first string' ) +``` + +the second inserted string will become the string at the *first* position (1) and all other strings +are shifted by one: + +```none +element 1: 'A new first string' +element 2: 'The first string' +element 3: ... +``` + +If you need the last but one string, you can do so in this way: + +```fortran +write(*,*) 'The last but one: ', list%get(list_end-1) +``` + +So, it is possible to do simple arithmetic. + + +## The derived type: stringlist_type + +### Status + +Experimental + +### Description + +The type holds a small number of components and gives access to a number of procedures, +some of which are implemented as subroutines, others as functions or as operations. + + +### Public `stringlist_type` methods + +The following methods are defined: + +Method | Class | Description +---------------------|------------|------------ +[`delete`](./stdlib_stringlist.html#delete-delete_one_or_more_strings) | Subroutine | Delete one or more strings from the list +[`destroy`](./stdlib_stringlist.html#destroy_destroy_all_strings_in_the_list) | Subroutine | Destroy the contents of the list +[`get`](./stdlib_stringlist.html#get-get_a_single_string_from_a_list) | Function | Get a string from a particular position +[`index`](./stdlib_stringlist.html#index-find_the_index_of_a_particular_string_in_the_list) | Function | Find the index of a string in a list +[`index_sub`](./stdlib_stringlist.html#index_sub-find_the_index_of_a_particular_string_containing_the_given_substring) | Function | Find the index of a string containing a partilcar substring +[`insert`](./stdlib_stringlist.html#insert-insert_one_or_more_strings_after_a_given_position) | Subroutine | Insert a string or a list after a given position +[`length`](./stdlib_stringlist.html#length-return_the_length_of_the_list) | Function | Return the index of the last set position +[`range`](./stdlib_stringlist.html#range-retrieve_a_range_of_string_from_the_list) | Function | Retrieve a range of strings from the list +[`replace`](./stdlib_stringlist.html#replace-replace_one_or_more_strings_between_two_given_positions) | Subroutine | Replace one or more stringa between two positions +[`sort`](./stdlib_stringlist.html#sort-return_a_sorted_list) | Function | Sort the list and return the result as a new list +[`=`](./stdlib_stringlist.html#assign-copy_the_contents_of_a_list) | Assignment | Copy a list +[`//`](./stdlib_stringlist.html#//-concatenate_a_list_with_one_or_more_strings) | Operation | Concatenate a list with a string or concatenate two lists + + +## Details of the methods + +### `delete` - delete one or more strings + +#### Status + +Experimental + +#### Description + +Delete one or more strings from the list via a given position or positions. + +#### Syntax + +`call list % [[stringlist_type(type):delete(bound)]]( first [, last] )` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable from which to delete one or more strings + +`first`: the index of the first string to be deleted + +`last` (optional): the index of the last string to be deleted. If left out, only one string is deleted. +If the value is lower than that of `first`, the range is considered to be empty and nothing is deleted. + + +### `destroy` - destroy all strings in the list + +#### Status + +Experimental + +#### Description + +Destroy the entire contents of the list. As the variable holding the list is simply a derived type, the variable +itself is not destroyed. + +#### Syntax + +`call list % [[stringlist_type(type):destroy(bound)]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable from which to delete all strings + + +### `get` - get a single string from the list + +#### Status + +Experimental + +#### Description + +Get the string at the given position. + +#### Syntax + +`string = list % [[stringlist_type(type):get(bound) ( idx )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve a string from + +`idx`: the index of the string to be retrieved (see [`the section on positions`](./stdlib_stringlist.html#position-in-a-list-of-strings) + +#### Result value + +A copy of the string stored at the indicated position. + + +### `index` - find the index of a particular string in the list + +#### Status + +Experimental + +#### Description + +Get the position of the first stored string that matches the given string, if `back` is not present or false. If `back` is +false, return the position of the last stored string that matches. Note that trailing blanks are ignored. + +#### Syntax + +`idx = list % [[stringlist_type(type):index(bound) ( string, back )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve a string from + +`string`: the string to be found in the list + +`back` (optional): logical argument indicating the first occurrence should be returned (`false`) or the last (`true`) + +#### Result value + +The result is either the index of the string in the list or -1 if the string was not found + +#### Example + +Because trailing blanks are ignored, the following calls will give the same result: + +```fortran + write(*,*) list%index( 'A' ) + write(*,*) list%index( 'A ' ) +``` + + +### `index_sub` - find the index of a string containing the given substring in the list + +#### Status + +Experimental + +#### Description + +Get the position of the first stored string that contains the given substring, if `back` is not present or false. If `back` is +false, return the position of the last stored string that contains it. + +#### Syntax + +`idx = list % [[stringlist_type(type):index_sub(bound) ( substring, back )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve a string from + +`substring`: the substring in question + +`back` (optional): logical argument indicating the first occurrence should be returned (`false`) or the last (`true`) + +#### Result value + +The result is either the index of the string in the list or -1 if the string was not found + + +### `insert` - insert one or more strings after a given position + +#### Status + +Experimental + +#### Description + +Insert one or more strings at a given position. The position may be anything as explained in the section on positions. +A single string may be inserted, another list of strings or a plain array of strings. In all cases trailing blanks, if any, +are retained. + +#### Syntax + +`idx = list % [[stringlist_type(type):insert(bound) ( idx, string )]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable to insert the string(s) into + +`idx`: the position after which the strings should be inserted + +`string`: the string to be inserted, a list of strings or a plain array of strings + + +### `length` - return the length of the list + +#### Status + +Experimental + +#### Description + +Return the length of the list, defined as the highest index for which a string has been assigned. You can place strings +in any position without needing to fill in the intervening positions. + +#### Syntax + +`length = list % [[stringlist_type(type):length(bound) ()]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve the length from + +#### Result value + +Returns the highest index of a string that has been set. + + + +### `range` - retrieve a range of strings from the list + +#### Status + +Experimental + +#### Description + +Retrieve the strings occurring between the given positions as a new list. + +#### Syntax + +`rangelist = list % [[stringlist_type(type):range(bound) ( first, last )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to insert the string(s) into + +`first`: the position of the first string to be retrieved + +`last`: the position of the last string to be retrieved + +#### Result value + +The result is a new list containing all the strings that appear from the first to the last position, inclusively. + + + +### `replace` - replace one or more strings between two given positions + +#### Status + +Experimental + +#### Description + +Replace one or more strings between two given positions. The new strings may be given as a single string, a list of +strings or a plain array. + +#### Syntax + +`call list % [[stringlist_type(type):replace(bound) ( first, last, string )]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable to replace the string(s) in + + +`first`: the position of the first string to be retrieved + +`last`: the position of the last string to be retrieved. If only one string needs to be replaced by another string, +then this argument can be left out. + +`string`: the string to be inserted, a list of strings or a plain array of strings + + + +### `sort` - return a sorted list + +#### Status + +Experimental + +#### Description + +Create a new list consisting of the sorted strings of the given list. The strings are sorted according to ASCII, either +in ascending order or descending order. + +#### Syntax + +`sortedlist = list % [[stringlist_type(type):sort(bound) ( ascending )]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable of which the contents should be copied + +`ascending` (optional): if not present or true, sort the list in ascending order, otherwise descending + +#### Result value + +The contents of the given list is sorted and then stored in the new list. + + +### `=` - copy the contents of a list + +#### Status + +Experimental + +#### Description + +Copy an existing list to a new one. The original list remains unchanged. + +#### Syntax + +`copylist = list` + +#### Class + +Assignment + +#### Operands + +`list`: the stringlist variable to be copied + + + +### `//` - concatenate a list with one or more strings + +#### Status + +Experimental + +#### Description + +Concatenate a list with a string, a list of strings or a plain array + +#### Syntax + +`concatenatedlist = list // string` + +`concatenatedlist = string // list` + +#### Class + +Assignment + +#### Operands + +`list`: the stringlist variable to be concatenated + +`string`: the string to be concatenated, a list of strings or a plain array of strings + +#### Result value + +A stringlist that contains the concatenation of the two operands. + + + +## TODO + +Additional methods: + +filter + +map + +Suggestions from the discussion diff --git a/src/stdlib_stringlist.f90 b/src/stdlib_stringlist.f90 new file mode 100644 index 000000000..4dfb192ed --- /dev/null +++ b/src/stdlib_stringlist.f90 @@ -0,0 +1,996 @@ +! stdlib_stringlist.f90 -- +! Module for storing and manipulating lists of strings +! The strings may have arbitrary lengths, not necessarily the same +! +! Note: very preliminary +! +! TODO: +! insert( list_end, ... ) in an empty list? +! concatenate two string lists +! +! Not implemented yet: +! insert a list or an array of character strings +! replace a string, list or an array of character strings +! concatenate a list with another list or an array +! +! Limited to implemented routines +! +module stdlib_stringlist + implicit none + + private + public :: stringlist_type + public :: operator(//) + public :: operator(+) + public :: operator(-) + public :: list_end + + type stringlist_index_type + private + logical :: head + integer :: offset + end type stringlist_index_type + + type(stringlist_index_type), parameter :: list_head = stringlist_index_type( .true., 1 ) + type(stringlist_index_type), parameter :: list_end = stringlist_index_type( .false., 0 ) + type(stringlist_index_type), parameter :: list_after_end = stringlist_index_type( .false., 1 ) + + interface operator(+) + module procedure stringlist_index_add + end interface + + interface operator(-) + module procedure stringlist_index_subtract + end interface + + type string_type + character(len=:), allocatable :: value + end type string_type + + type stringlist_type + private + integer :: size = 0 + type(string_type), dimension(:), allocatable :: string + contains + private + procedure, public :: destroy => destroy_list + procedure :: insert_string_idx => insert_string_idx_wrap + procedure :: insert_string_int => insert_string_int_impl + procedure :: insert_stringlist_idx => insert_stringlist_idx_wrap + procedure :: insert_stringlist_int => insert_stringlist_int_impl + procedure :: insert_stringarray_idx => insert_stringarray_idx_wrap + procedure :: insert_stringarray_int => insert_stringarray_int_impl + generic, public :: insert => insert_string_int, insert_string_idx, & + insert_stringlist_int, insert_stringlist_idx, & + insert_stringarray_int, insert_stringarray_idx + procedure :: get_string_int => get_string_int_impl + procedure :: get_string_idx => get_string_idx_wrap + generic, public :: get => get_string_int, get_string_idx + procedure, public :: length => length_list + procedure, public :: sort => sort_list + procedure, public :: index => index_of_string + procedure, public :: index_sub => index_of_substring + procedure :: delete_strings_int_int => delete_strings_int_int_impl + procedure :: delete_strings_idx_int => delete_strings_idx_int_wrap + procedure :: delete_strings_int_idx => delete_strings_int_idx_wrap + procedure :: delete_strings_idx_idx => delete_strings_idx_idx_wrap + generic, public :: delete => delete_strings_int_int, delete_strings_idx_int, & + delete_strings_int_idx, delete_strings_idx_idx + procedure :: range_list_int_int => range_list_int_int_impl + procedure :: range_list_idx_int => range_list_idx_int_wrap + procedure :: range_list_int_idx => range_list_int_idx_wrap + procedure :: range_list_idx_idx => range_list_idx_idx_wrap + generic, public :: range => range_list_int_int, range_list_idx_idx, & + range_list_int_idx, range_list_idx_int + procedure :: replace_string_idx => replace_string_idx_wrap + procedure :: replace_string_int => replace_string_int_impl + procedure :: replace_string_int_int => replace_string_int_int_impl + procedure :: replace_stringarray_int_int => replace_stringarray_int_int_impl + procedure :: replace_stringlist_int_int => replace_stringlist_int_int_impl + procedure :: replace_string_idx_idx => replace_string_idx_idx_wrap + procedure :: replace_stringarray_idx_idx => replace_stringarray_idx_idx_wrap + procedure :: replace_stringlist_idx_idx => replace_stringlist_idx_idx_wrap + procedure :: replace_string_idx_int => replace_string_idx_int_wrap + procedure :: replace_stringarray_idx_int => replace_stringarray_idx_int_wrap + procedure :: replace_stringlist_idx_int => replace_stringlist_idx_int_wrap + procedure :: replace_string_int_idx => replace_string_int_idx_wrap + procedure :: replace_stringarray_int_idx => replace_stringarray_int_idx_wrap + procedure :: replace_stringlist_int_idx => replace_stringlist_int_idx_wrap + generic, public :: replace => replace_string_int_int, replace_stringarray_int_int, & + replace_stringlist_int_int, & + replace_string_idx, replace_string_int, & + replace_string_idx_idx, replace_stringarray_idx_idx, & + replace_stringlist_idx_idx, & + replace_string_idx_int, replace_stringarray_idx_int, & + replace_stringlist_idx_int, & + replace_string_int_idx, replace_stringarray_int_idx, & + replace_stringlist_int_idx + end type stringlist_type + + interface operator(<) + module procedure string_lower + end interface + + interface operator(>) + module procedure string_greater + end interface + + interface operator(==) + module procedure string_equal + end interface + + interface operator(//) + module procedure append_string + module procedure prepend_string + module procedure append_stringlist + module procedure append_stringarray + module procedure prepend_stringarray + end interface +contains + +! stringlist_index_add -- +! Add an integer offset to the special index +! +! Arguments: +! index Special index +! offset Offset to be added +! +function stringlist_index_add( index, offset ) + type(stringlist_index_type), intent(in) :: index + integer, intent(in) :: offset + + type(stringlist_index_type) :: stringlist_index_add + + stringlist_index_add = index + stringlist_index_add%offset = stringlist_index_add%offset + offset +end function stringlist_index_add + +! stringlist_index_substract -- +! Subtract an integer offset to the special index +! +! Arguments: +! index Special index +! offset Offset to be substracted +! +function stringlist_index_subtract( index, offset ) + type(stringlist_index_type), intent(in) :: index + integer, intent(in) :: offset + + type(stringlist_index_type) :: stringlist_index_subtract + + stringlist_index_subtract = index + stringlist_index_subtract%offset = stringlist_index_subtract%offset - offset +end function stringlist_index_subtract + +! compare string_type derived types +! Required by sorting functions +! +elemental logical function string_lower( string1, string2 ) + type(string_type), intent(in) :: string1 + type(string_type), intent(in) :: string2 + + string_lower = string1%value < string2%value +end function string_lower + +elemental logical function string_greater( string1, string2 ) + type(string_type), intent(in) :: string1 + type(string_type), intent(in) :: string2 + + string_greater = string1%value > string2%value +end function string_greater + +elemental logical function string_equal( string1, string2 ) + type(string_type), intent(in) :: string1 + type(string_type), intent(in) :: string2 + + string_equal = string1%value == string2%value +end function string_equal + +function append_string( list, string ) + type(stringlist_type), intent(in) :: list + character(len=*), intent(in) :: string + type(stringlist_type) :: append_string + + append_string = list + call append_string%insert( list_after_end, string ) +end function append_string + +function prepend_string( string, list ) + character(len=*), intent(in) :: string + type(stringlist_type), intent(in) :: list + type(stringlist_type) :: prepend_string + + prepend_string = list + call prepend_string%insert( list_head, string ) +end function prepend_string + +function append_stringlist( slist, list ) + type(stringlist_type), intent(in) :: list + type(stringlist_type), intent(in) :: slist + type(stringlist_type) :: append_stringlist + + append_stringlist = list + call append_stringlist%insert( list_after_end, slist ) +end function append_stringlist + +function append_stringarray( list, sarray ) + type(stringlist_type), intent(in) :: list + character(len=*), dimension(:), intent(in) :: sarray + type(stringlist_type) :: append_stringarray + + append_stringarray = list + call append_stringarray%insert( list_after_end, sarray ) +end function append_stringarray + +function prepend_stringarray( sarray, list ) + character(len=*), dimension(:), intent(in) :: sarray + type(stringlist_type), intent(in) :: list + type(stringlist_type) :: prepend_stringarray + + prepend_stringarray = list + call prepend_stringarray%insert( list_head, sarray ) +end function prepend_stringarray + + +! destroy_list -- +! Destroy the contetns of the list +! +! Arguments: +! list The list of strings in question +! +subroutine destroy_list( list ) + class(stringlist_type), intent(inout) :: list + + list%size = 0 + deallocate( list%string ) +end subroutine destroy_list + +! length_list -- +! Return the size (length) of the list +! +! Arguments: +! list The list of strings to retrieve the string from +! +integer function length_list( list ) + class(stringlist_type), intent(in) :: list + + length_list = list%size +end function length_list + +! insert_string -- +! Insert a new string (or an array of strings of another list) into the list +! +! Arguments: +! list The list of strings where the new string(s) should be inserted +! idx Index at which to insert the string +! string The string in question +! +subroutine insert_string_idx_wrap( list, idx, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%insert( idxabs, string ) +end subroutine insert_string_idx_wrap + +subroutine insert_stringlist_idx_wrap( list, idx, slist ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + class(stringlist_type), intent(in) :: slist + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%insert( idxabs, slist ) +end subroutine insert_stringlist_idx_wrap + +subroutine insert_stringarray_idx_wrap( list, idx, sarray ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=*), dimension(:), intent(in) :: sarray + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%insert( idxabs, sarray ) +end subroutine insert_stringarray_idx_wrap + +! insert_empty_positions +! Insert a number of positions for new strings +! +! Arguments: +! list The list of strings where the empty positions should be inserted +! idxn Index at which the positions should be inserted +! number Number of positions +! +subroutine insert_empty_positions( list, idxn, number ) + class(stringlist_type), intent(inout) :: list + integer, intent(inout) :: idxn + integer, intent(in) :: number + + integer :: i, inew + integer :: lastidx + type(string_type), dimension(:), allocatable :: new_string + + ! + ! Clip the index between 1 and size+1 + ! + idxn = max( 1, min(list%size+1, idxn ) ) + + ! + ! Check if the array list%string is large enough + ! Make room in any case + ! + if ( .not. allocated(list%string) ) then + allocate(list%string(1) ) + endif + + lastidx = list%size + number + + ! + ! Do we need a copy? + ! + if ( size(list%string) < lastidx ) then + allocate( new_string(lastidx) ) + + do i = 1,idxn-1 + call move_alloc( list%string(i)%value, new_string(i)%value ) + enddo + + do i = idxn, list%size + inew = i + number + call move_alloc( list%string(i)%value, new_string(inew)%value ) + enddo + call move_alloc( new_string, list%string ) + else + do i = idxn, list%size + inew = i + number + call move_alloc( list%string(i)%value, list%string(inew)%value ) + enddo + endif + + list%size = list%size + number + +end subroutine insert_empty_positions + +! insert_string_int_impl -- +! Insert a new string into the list - specific implementation +! +subroutine insert_string_int_impl( list, idx, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxn + type(string_type) :: new_element + type(string_type), dimension(:), allocatable :: new_string + + idxn = idx + call insert_empty_positions( list, idxn, 1 ) + + list%string(idxn)%value = string + +end subroutine insert_string_int_impl + +! insert_stringlist_int_impl -- +! Insert a list of strings into the list - specific implementation +! +subroutine insert_stringlist_int_impl( list, idx, slist ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + class(stringlist_type), intent(in) :: slist + + integer :: i + integer :: idxn, idxnew + + idxn = idx + call insert_empty_positions( list, idxn, slist%size ) + + do i = 1, slist%size + idxnew = max( 1, idxn ) + i - 1 + list%string(idxnew)%value = slist%string(i)%value + enddo + +end subroutine insert_stringlist_int_impl + +! insert_stringarray_int_impl -- +! Insert an array of strings into the list - specific implementatinon +! +subroutine insert_stringarray_int_impl( list, idx, sarray ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + character(len=*), dimension(:), intent(in) :: sarray + + integer :: i + integer :: idxn, idxnew + + idxn = idx + call insert_empty_positions( list, idxn, size(sarray) ) + + do i = 1, size(sarray) + idxnew = max( 1, idxn ) + i - 1 + list%string(idxnew)%value = sarray(i) + enddo + +end subroutine insert_stringarray_int_impl + +! get_string -- +! Get the string at a particular index +! +! Arguments: +! list The list of strings to retrieve the string from +! idx Index after which to insert the string +! +function get_string_idx_wrap( list, idx ) + class(stringlist_type), intent(in) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=:), allocatable :: get_string_idx_wrap + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + get_string_idx_wrap = list%get( idxabs ) +end function get_string_idx_wrap + +function get_string_int_impl( list, idx ) + class(stringlist_type), intent(in) :: list + integer, intent(in) :: idx + character(len=:), allocatable :: get_string_int_impl + + integer :: idxnew + + ! + ! Examine the actual index: + ! - if the index is larger than the size, return an empty string + ! - if the index is equal to list_head, interpret it as index 1 + ! - if the index is negative, calculate the absolute index + ! + if ( idx > list%size .or. idx < 1 ) then + get_string_int_impl = '' + else + get_string_int_impl = list%string(idx)%value + endif +end function get_string_int_impl + +! sort_list -- +! Sort the list and return the result as a new list +! +! Arguments: +! list The list of strings to retrieve the string from +! ascending Whether to sort as ascending (true) or not (false) +! +function sort_list( list, ascending ) + class(stringlist_type), intent(in) :: list + logical, intent(in), optional :: ascending + + integer :: i + integer, dimension(:), allocatable :: idx + class(stringlist_type), allocatable :: sort_list + logical :: ascending_order + + ! + ! Allocate and fill the index array, then sort the indices + ! based on the strings + ! + idx = [ (i ,i=1,list%size) ] + + ascending_order = .true. + if ( present(ascending) ) then + ascending_order = ascending + endif + + if ( ascending_order ) then + idx = sort_ascending( idx ) + else + idx = sort_descending( idx ) + endif + + allocate( sort_list ) + allocate( sort_list%string(list%size) ) + + do i = 1,list%size + sort_list%string(i) = list%string(idx(i)) + enddo + sort_list%size = list%size + +contains +recursive function sort_ascending( idx ) result(idxnew) + integer, dimension(:) :: idx + integer, dimension(size(idx)) :: idxnew + + if ( size(idx) > 1 ) then + idxnew = [ sort_ascending( pack( idx, list%string(idx) < list%string(idx(1)) ) ), & + pack( idx, list%string(idx) == list%string(idx(1)) ) , & + sort_ascending( pack( idx, list%string(idx) > list%string(idx(1)) ) ) ] + else + idxnew = idx + endif +end function sort_ascending + +recursive function sort_descending( idx ) result(idxnew) + integer, dimension(:) :: idx + integer, dimension(size(idx)) :: idxnew + + if ( size(idx) > 1 ) then + idxnew = [ sort_descending( pack( idx, list%string(idx) > list%string(idx(1)) ) ), & + pack( idx, list%string(idx) == list%string(idx(1)) ) , & + sort_descending( pack( idx, list%string(idx) < list%string(idx(1)) ) ) ] + else + idxnew = idx + endif +end function sort_descending + +end function sort_list + +! index_of_string -- +! Return the index in the list of a particular string +! +! Arguments: +! list The list of strings in which to search the string +! string The string to be found +! back Whether to search from the end (true) or not (false, default) +! +integer function index_of_string( list, string, back ) + class(stringlist_type), intent(in) :: list + character(len=*), intent(in) :: string + logical, intent(in), optional :: back + + integer :: idx + integer :: i + logical :: start_backwards + + start_backwards = .false. + if ( present(back) ) then + start_backwards = back + endif + + idx = 0 + if ( start_backwards) then + do i = list%size,1,-1 + if ( list%string(i)%value == string ) then + idx = i + exit + endif + enddo + else + do i = 1,list%size + if ( list%string(i)%value == string ) then + idx = i + exit + endif + enddo + endif + + index_of_string = idx +end function index_of_string + +! index_of_substring -- +! Return the index in the list of a string containing a particular substring +! +! Arguments: +! list The list of strings in which to search the string +! substring The substring to be found +! back Whether to search from the end (true) or not (false, default) +! +integer function index_of_substring( list, substring, back ) + class(stringlist_type), intent(in) :: list + character(len=*), intent(in) :: substring + logical, intent(in), optional :: back + + integer :: idx + integer :: i + logical :: start_backwards + + start_backwards = .false. + if ( present(back) ) then + start_backwards = back + endif + + idx = 0 + if ( start_backwards) then + do i = list%size,1,-1 + if ( index(list%string(i)%value, substring) > 0 ) then + idx = i + exit + endif + enddo + else + do i = 1,list%size + if ( index(list%string(i)%value, substring) > 0 ) then + idx = i + exit + endif + enddo + endif + + index_of_substring = idx +end function index_of_substring + +! delete_strings -- +! Delete one or more strings from the list +! +! Arguments: +! list The list of strings in which to search the string +! first The position of the first string to be deleted +! last The position of the last string to be deleted +! +! Note: +! If the range defined by first and last has a zero length or first > last, +! then nothing happens. +! +subroutine delete_strings_idx_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + + integer :: firstpos + integer :: lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%delete( firstpos, lastpos ) +end subroutine delete_strings_idx_idx_wrap + +subroutine delete_strings_int_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + + integer :: firstpos + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%delete( firstpos, lastpos ) +end subroutine delete_strings_int_idx_wrap + +subroutine delete_strings_idx_int_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + + integer :: firstpos + integer :: lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%delete( firstpos, lastpos ) +end subroutine delete_strings_idx_int_wrap + +subroutine delete_strings_int_int_impl( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + + integer :: firstpos + integer :: lastpos + integer :: i + integer :: j + + if ( first > list%size .or. last < 1 ) then + return + endif + + firstpos = max( 1, min(list%size, first ) ) + lastpos = max( 1, min(list%size, last ) ) + + if ( firstpos > lastpos ) then + return + else + do i = lastpos+1,list%size + j = firstpos + i - lastpos - 1 + call move_alloc( list%string(i)%value, list%string(j)%value ) + enddo + do i = list%size - (lastpos-firstpos), list%size + list%string(i)%value = '' + enddo + + list%size = list%size - (lastpos-firstpos + 1) + endif +end subroutine delete_strings_int_int_impl + +! range_list -- +! Return a sublist given by the first and last position +! +! Arguments: +! list The list of strings in which to search the string +! first The position of the first string to be deleted +! last The position of the last string to be deleted +! +! Note: +! If the range defined by first and last has a zero length or first > last, +! then return an empty list +! +function range_list_idx_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), allocatable :: range_list_idx_idx_wrap + + integer :: firstpos + integer :: lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + range_list_idx_idx_wrap = list%range( firstpos, lastpos ) + +end function range_list_idx_idx_wrap + +function range_list_int_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), allocatable :: range_list_int_idx_wrap + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + range_list_int_idx_wrap = list%range( first, lastpos ) + +end function range_list_int_idx_wrap + +function range_list_idx_int_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), allocatable :: range_list_idx_int_wrap + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + range_list_idx_int_wrap = list%range( firstpos, last ) + +end function range_list_idx_int_wrap + +function range_list_int_int_impl( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), allocatable :: range_list_int_int_impl + + integer :: firstpos + integer :: lastpos + + allocate( range_list_int_int_impl ) + + if ( first > list%size .or. last < 1 ) then + allocate( range_list_int_int_impl%string(0) ) + return + endif + + firstpos = max( 1, min(list%size, first ) ) + lastpos = max( 1, min(list%size, last ) ) + + if ( firstpos > lastpos ) then + allocate( range_list_int_int_impl%string(0) ) + return + else + range_list_int_int_impl%size = lastpos - firstpos + 1 + range_list_int_int_impl%string = list%string(firstpos:lastpos) + endif +end function range_list_int_int_impl + + +! replace_string -- +! Replace a string in the list +! +! Arguments: +! list The list of strings in which to replace a string (or a range of strings) +! first First index of the string(s) to be replaced +! last Last index of the string(s) to be replaced +! string The string in question (array of strings or another string list) +! +! Note: +! For convenience a version that simply replaces a single string is provided +! +subroutine replace_string_idx_wrap( list, idx, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxpos + + idxpos = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%replace( idxpos, string ) +end subroutine replace_string_idx_wrap + +subroutine replace_string_int_impl( list, idx, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxpos + + if ( idx < 1 .or. idx > list%size ) then + return + endif + + list%string(idx)%value = string +end subroutine replace_string_int_impl + +subroutine replace_string_idx_idx_wrap( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), intent(in) :: string + + integer :: firstpos, lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( firstpos, lastpos, string ) +end subroutine replace_string_idx_idx_wrap + +subroutine replace_string_int_idx_wrap( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), intent(in) :: string + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( first, lastpos, string ) +end subroutine replace_string_int_idx_wrap + +subroutine replace_string_idx_int_wrap( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + character(len=*), intent(in) :: string + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%replace( firstpos, last, string ) +end subroutine replace_string_idx_int_wrap + +subroutine replace_string_int_int_impl( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + character(len=*), intent(in) :: string + + if ( first > list%size .or. last < 1 ) then + return + endif + if ( first > last ) then + return + endif + + call list%delete( first, last ) + call list%insert( first, string ) +end subroutine replace_string_int_int_impl + + +subroutine replace_stringlist_idx_idx_wrap( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), intent(in) :: slist + + integer :: firstpos, lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( firstpos, lastpos, slist ) +end subroutine replace_stringlist_idx_idx_wrap + +subroutine replace_stringlist_int_idx_wrap( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), intent(in) :: slist + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( first, lastpos, slist ) +end subroutine replace_stringlist_int_idx_wrap + +subroutine replace_stringlist_idx_int_wrap( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), intent(in) :: slist + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%replace( firstpos, last, slist ) +end subroutine replace_stringlist_idx_int_wrap + +subroutine replace_stringlist_int_int_impl( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), intent(in) :: slist + + if ( first > list%size .or. last < 1 ) then + return + endif + if ( first > last ) then + return + endif + + call list%delete( first, last ) + call list%insert( first, slist ) +end subroutine replace_stringlist_int_int_impl + + +subroutine replace_stringarray_idx_idx_wrap( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + integer :: firstpos, lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( firstpos, lastpos, sarray ) +end subroutine replace_stringarray_idx_idx_wrap + +subroutine replace_stringarray_int_idx_wrap( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( first, lastpos, sarray ) +end subroutine replace_stringarray_int_idx_wrap + +subroutine replace_stringarray_idx_int_wrap( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%replace( firstpos, last, sarray ) +end subroutine replace_stringarray_idx_int_wrap + +subroutine replace_stringarray_int_int_impl( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + if ( first > list%size .or. last < 1 ) then + return + endif + if ( first > last ) then + return + endif + + call list%delete( first, last ) + call list%insert( first, sarray ) +end subroutine replace_stringarray_int_int_impl + +end module stdlib_stringlist diff --git a/src/tests/stringlist/CMakeLists.txt b/src/tests/stringlist/CMakeLists.txt new file mode 100644 index 000000000..7bf83a41a --- /dev/null +++ b/src/tests/stringlist/CMakeLists.txt @@ -0,0 +1,4 @@ +ADDTEST(insert) +ADDTEST(delete) +ADDTEST(find) +ADDTEST(replace_append) diff --git a/src/tests/stringlist/test_delete.f90 b/src/tests/stringlist/test_delete.f90 new file mode 100644 index 000000000..5c3cf0870 --- /dev/null +++ b/src/tests/stringlist/test_delete.f90 @@ -0,0 +1,57 @@ +! test_delete.f90 -- +! Test the delete routine +! +program test_deletion + use stdlib_stringlist + + type(stringlist_type) :: list + + + call list%insert( 1, ["A", "B", "C", "D", "E", "F"] ) + + call list%delete( 1, 1 ) + + write(*,*) 'Expected: B, C, D, E, F (5)' + call print_list( list ) + + call list%delete( list_end, list_end ) + + write(*,*) 'Expected: B, C, D, E (4)' + call print_list( list ) + + call list%delete( list_end+1, list_end+1 ) + + write(*,*) 'Expected: B, C, D, E (4)' + call print_list( list ) + + call list%delete( 3, 2 ) + + write(*,*) 'Expected: B, C, D, E (4)' + call print_list( list ) + + call list%delete( 2, 3 ) + + write(*,*) 'Expected: B, E (2)' + call print_list( list ) + +contains +subroutine renew_list( list ) + type(stringlist_type), intent(inout) :: list + + call list%destroy + call list%insert( 1, "A" ) + call list%insert( 2, "B" ) + call list%insert( 3, "C" ) +end subroutine renew_list + +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_deletion diff --git a/src/tests/stringlist/test_find.f90 b/src/tests/stringlist/test_find.f90 new file mode 100644 index 000000000..3db7bd806 --- /dev/null +++ b/src/tests/stringlist/test_find.f90 @@ -0,0 +1,72 @@ +! test_find.f90 -- +! Test the various retrieval routines +! +program test_find + use stdlib_stringlist + + type(stringlist_type) :: list, sublist + character(len=:), allocatable :: string + + call list%insert( 1, ["A", "B", "C", "D", "E", "F"] ) + + write(*,*) 'Expected: A' + write(*,*) list%get(1) + write(*,*) list%get(list_head) + write(*,*) 'Expected: B' + write(*,*) list%get(list_head+1) + write(*,*) 'Expected: F' + write(*,*) list%get(list_end) + write(*,*) 'Expected: (nothing)' + write(*,*) list%get(list_end+1) + + call list%destroy + call list%insert( 1, ["AA", "BA", "CA", "AA", "BA", "CA"] ) + write(*,*) 'Expected: 1' + write(*,*) list%index("AA") + write(*,*) 'Expected: 4' + write(*,*) list%index("AA", .true.) + write(*,*) 'Expected: 0' + write(*,*) list%index("XXXX") + + write(*,*) 'Expected: 2' + write(*,*) list%index_sub("B") + write(*,*) 'Expected: 5' + write(*,*) list%index_sub("B", .true.) + write(*,*) 'Expected: 0' + write(*,*) list%index_sub("X") + + write(*,*) 'Expected: 6', list%length() + + sublist = list%range(1, 2) + write(*,*) 'Expected: AA, BA' + call print_list( sublist ) + + sublist = list%range(list_end-1, list_end+2) + write(*,*) 'Expected: BA, CA' + call print_list( sublist ) + + sublist = list%range(-1, 3) + write(*,*) 'Expected: AA, BA, CA' + call print_list( sublist ) + +contains +subroutine renew_list( list ) + type(stringlist_type), intent(inout) :: list + + call list%destroy + call list%insert( 1, "A" ) + call list%insert( 2, "B" ) + call list%insert( 3, "C" ) +end subroutine renew_list + +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_find diff --git a/src/tests/stringlist/test_insert.f90 b/src/tests/stringlist/test_insert.f90 new file mode 100644 index 000000000..6aa6b1198 --- /dev/null +++ b/src/tests/stringlist/test_insert.f90 @@ -0,0 +1,91 @@ +! test_insert.f90 -- +! Test the insertion routine +! +program test_insertion + use stdlib_stringlist + + type(stringlist_type) :: list, second_list + character(len=10), dimension(3) :: sarray + + + call list%insert( 1, "C" ) + call list%insert( 1, "B" ) + call list%insert( 1, "A" ) + + write(*,*) 'Expected: A, B, C (3)' + call print_list( list ) + + call list%insert( 6, "D" ) + + write(*,*) 'Expected: A, B, C, D (4)' + call print_list( list ) + + call list%insert( -1, "X" ) + + write(*,*) 'Expected: X, A, B, C, D (5)' + call print_list( list ) + + call list%insert( list_end-1, "Y" ) + + write(*,*) 'Expected: X, A, B, Y, C, D (6)' + call print_list( list ) + + call list%insert( list_end+1, "Z" ) + + write(*,*) 'Expected: X, A, B, Y, C, D, Z (7)' + call print_list( list ) + + ! + ! Try inserting a second list + ! + call renew_list( list ) + + call second_list%insert( 1, "SecondA" ) + call second_list%insert( 2, "SecondB" ) + + call list%insert( 2, second_list ) + call print_list( list ) + + call renew_list( list ) + + call list%insert( list_after_end, second_list ) + call print_list( list ) + + ! + ! Try inserting an array + ! + call renew_list( list ) + + sarray(1) = "ThirdA" + sarray(2) = "ThirdB" + sarray(3) = "ThirdC" + + call list%insert( list_head, sarray ) + call print_list( list ) + + call renew_list( list ) + + call list%insert( 2, sarray ) + call print_list( list ) + +contains +subroutine renew_list( list ) + type(stringlist_type), intent(inout) :: list + + call list%destroy + call list%insert( 1, "A" ) + call list%insert( 2, "B" ) + call list%insert( 3, "C" ) +end subroutine renew_list + +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_insertion diff --git a/src/tests/stringlist/test_replace_append.f90 b/src/tests/stringlist/test_replace_append.f90 new file mode 100644 index 000000000..b7c0c26ed --- /dev/null +++ b/src/tests/stringlist/test_replace_append.f90 @@ -0,0 +1,88 @@ +! test_replace_append.f90 -- +! Test the replace and append routines +! +program test_replace_append + use stdlib_stringlist + + type(stringlist_type) :: list, newlist + + call list%insert( 1, ["A", "B", "C", "D", "E", "F"] ) + + newlist = 'Long string' // list + + write(*,*) 'Expected: "Long string, A, B, C, D, E, F (7)' + call print_list( newlist ) + + newlist = list // 'Long string' + + write(*,*) 'Expected: A, B, C, D, E, F, "Long string" (7)' + call print_list( newlist ) + + newlist = list // list + + write(*,*) 'Expected: A, B, C, D, E, F (twice, 12 elements)' + call print_list( newlist ) + + newlist = ['AA', 'BB'] // list + write(*,*) 'Expected: AA, BB, A, B, C, D, E, F (8)' + call print_list( newlist ) + + newlist = list // ['AA', 'BB'] + write(*,*) 'Expected: A, B, C, D, E, F, AA, BB (8)' + call print_list( newlist ) + + ! + ! Replace ... quite a variety + ! + newlist = list + call newlist%replace( 1, "New string" ) + write(*,*) 'Expected: "New string", B, C, D, E, F (6)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_head, "New string" ) + write(*,*) 'Expected: "New string", B, C, D, E, F (6)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_end, "New string" ) + write(*,*) 'Expected: A, B, C, D, E, F, "New string" (6)' + call print_list( newlist ) + + newlist = list + call newlist%replace( 5, list_end, "X" ) + write(*,*) 'Expected: A, B, C, D, X (5)' + call print_list( newlist ) + + newlist = list + call newlist%replace( 5, list_end-2, "X" ) + write(*,*) 'Expected: A, B, C, D, E, F (6 - no change)' + call print_list( newlist ) + + newlist = list + call newlist%replace( 1, 2, ["WW", "XX", "YY", "ZZ"] ) + write(*,*) 'Expected: WW, XX, YY, ZZ, C, D, E, F (8)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_end-1, list_end, ["WW", "XX", "YY", "ZZ"] ) + write(*,*) 'Expected: A, B, C, D, WW, XX, YY, ZZ (8)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_end-1, list_end, list ) + write(*,*) 'Expected: A, B, C, D, A, B, C, D, E, F (10)' + call print_list( newlist ) + +contains +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_replace_append From 90b06ff89ac3dce00e6c1d2f770beca38b837e34 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Thu, 4 Feb 2021 10:38:57 +0100 Subject: [PATCH 2/2] Correct typo There was a typo in some comments - corrected --- src/stdlib_stringlist.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_stringlist.f90 b/src/stdlib_stringlist.f90 index 4dfb192ed..570927d7b 100644 --- a/src/stdlib_stringlist.f90 +++ b/src/stdlib_stringlist.f90 @@ -145,12 +145,12 @@ function stringlist_index_add( index, offset ) stringlist_index_add%offset = stringlist_index_add%offset + offset end function stringlist_index_add -! stringlist_index_substract -- +! stringlist_index_subtract -- ! Subtract an integer offset to the special index ! ! Arguments: ! index Special index -! offset Offset to be substracted +! offset Offset to be subtracted ! function stringlist_index_subtract( index, offset ) type(stringlist_index_type), intent(in) :: index