From 90eb9aa859f7ec43351dacbe474e5f11119b02d9 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sun, 23 May 2021 23:42:40 +0530 Subject: [PATCH 01/18] implemented slice function for stdlib_ascii --- src/stdlib_ascii.fypp | 56 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 55 insertions(+), 1 deletion(-) diff --git a/src/stdlib_ascii.fypp b/src/stdlib_ascii.fypp index ce7257d01..9fc6ca74c 100644 --- a/src/stdlib_ascii.fypp +++ b/src/stdlib_ascii.fypp @@ -6,6 +6,7 @@ !> The specification of this module is available [here](../page/specs/stdlib_ascii.html). module stdlib_ascii use stdlib_kinds, only : int8, int16, int32, int64 + use stdlib_math, only: clip implicit none private @@ -20,7 +21,7 @@ module stdlib_ascii ! Character conversion functions public :: to_lower, to_upper, to_title, to_sentence, reverse - public :: to_string + public :: to_string, slice !> Version: experimental !> @@ -360,6 +361,59 @@ contains end function reverse + pure function slice(string, start, end, stride, include_end) result(sliced_string) + character(len=*), intent(in) :: string + integer, intent(in), optional :: start, end, stride + logical, intent(in), optional :: include_end + integer :: start_index, end_index, stride_vector, n, i, j + character(len=:), allocatable :: sliced_string + + start_index = 1 + end_index = len(string) + stride_vector = 1 + if (len(string) > 0) then + if (present(stride)) then + if (stride /= 0) then + if (stride < 0) then + start_index = len(string) + end_index = 1 + end if + stride_vector = stride + end if + else + if (present(start) .and. present(end)) then + if (end < start) then + stride_vector = -1 + end if + end if + end if + + if (present(start)) then + start_index = clip(start, 1, len(string)) + end if + if (present(end)) then + end_index = clip(end, 1, len(string)) + end if + + n = int((end_index - start_index) / stride_vector) + allocate(character(len=max(0, n + 1)) :: sliced_string) + + if (present(include_end)) then + if (include_end) then + start_index = end_index - (n * stride_vector) + end if + end if + + j = 1 + do i = start_index, end_index, stride_vector + sliced_string(j:j) = string(i:i) + j = j + 1 + end do + else + sliced_string = '' + end if + end function slice + #:for kind in INT_KINDS !> Represent an integer of kind ${kind}$ as character sequence pure function to_string_integer_${kind}$(val) result(string) From e235bc4df76f28673ef8ca459fd109bc147d7798 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 24 May 2021 00:00:56 +0530 Subject: [PATCH 02/18] added module dependencies of stdlib_math for function slice in Makefile.manual --- src/Makefile.manual | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index b372a8cb6..b9869ad6c 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -56,7 +56,9 @@ $(SRCGEN): %.f90: %.fypp common.fypp # Fortran module dependencies f18estop.o: stdlib_error.o -stdlib_ascii.o: stdlib_kinds.o +stdlib_ascii.o: \ + stdlib_kinds.o \ + stdlib_math.o stdlib_bitsets.o: stdlib_kinds.o stdlib_bitsets_64.o: stdlib_bitsets.o stdlib_bitsets_large.o: stdlib_bitsets.o From 0742ca0202c83c3f7b4a2ef354263b8cdb79fd29 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 24 May 2021 12:11:49 +0530 Subject: [PATCH 03/18] changed names from start to first and end to last --- src/stdlib_ascii.fypp | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/stdlib_ascii.fypp b/src/stdlib_ascii.fypp index 9fc6ca74c..8745ab58a 100644 --- a/src/stdlib_ascii.fypp +++ b/src/stdlib_ascii.fypp @@ -361,51 +361,51 @@ contains end function reverse - pure function slice(string, start, end, stride, include_end) result(sliced_string) + pure function slice(string, start, last, stride, include_last) result(sliced_string) character(len=*), intent(in) :: string - integer, intent(in), optional :: start, end, stride - logical, intent(in), optional :: include_end - integer :: start_index, end_index, stride_vector, n, i, j + integer, intent(in), optional :: first, last, stride + logical, intent(in), optional :: include_last + integer :: first_index, last_index, stride_vector, n, i, j character(len=:), allocatable :: sliced_string - start_index = 1 - end_index = len(string) + first_index = 1 + last_index = len(string) stride_vector = 1 if (len(string) > 0) then if (present(stride)) then if (stride /= 0) then if (stride < 0) then - start_index = len(string) - end_index = 1 + first_index = len(string) + last_index = 1 end if stride_vector = stride end if else - if (present(start) .and. present(end)) then - if (end < start) then + if (present(first) .and. present(last)) then + if (last < first) then stride_vector = -1 end if end if end if - if (present(start)) then - start_index = clip(start, 1, len(string)) + if (present(first)) then + first_index = clip(first, 1, len(string)) end if - if (present(end)) then - end_index = clip(end, 1, len(string)) + if (present(last)) then + last_index = clip(last, 1, len(string)) end if - n = int((end_index - start_index) / stride_vector) + n = int((last_index - first_index) / stride_vector) allocate(character(len=max(0, n + 1)) :: sliced_string) - if (present(include_end)) then - if (include_end) then - start_index = end_index - (n * stride_vector) + if (present(include_last)) then + if (include_last) then + first_index = last_index - (n * stride_vector) end if end if j = 1 - do i = start_index, end_index, stride_vector + do i = first_index, last_index, stride_vector sliced_string(j:j) = string(i:i) j = j + 1 end do From 1a5f78c394895bf0d6914d72a54545d2705362b3 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 24 May 2021 12:15:26 +0530 Subject: [PATCH 04/18] forgot to change the dummy argument start to first --- src/stdlib_ascii.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_ascii.fypp b/src/stdlib_ascii.fypp index 8745ab58a..641412e7f 100644 --- a/src/stdlib_ascii.fypp +++ b/src/stdlib_ascii.fypp @@ -361,7 +361,7 @@ contains end function reverse - pure function slice(string, start, last, stride, include_last) result(sliced_string) + pure function slice(string, first, last, stride, include_last) result(sliced_string) character(len=*), intent(in) :: string integer, intent(in), optional :: first, last, stride logical, intent(in), optional :: include_last From 15827d29a2d66700136e1574b4bc07c5d694c978 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 24 May 2021 17:28:29 +0530 Subject: [PATCH 05/18] shifted slice from stdlib_ascii to stdlib_strings and modified module dependencies accordingly --- src/Makefile.manual | 11 +++--- src/stdlib_ascii.fypp | 56 +----------------------------- src/stdlib_strings.f90 | 77 +++++++++++++++++++++++++++++++++++++++++- 3 files changed, 83 insertions(+), 61 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index b9869ad6c..322ddd0ae 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -56,9 +56,7 @@ $(SRCGEN): %.f90: %.fypp common.fypp # Fortran module dependencies f18estop.o: stdlib_error.o -stdlib_ascii.o: \ - stdlib_kinds.o \ - stdlib_math.o +stdlib_ascii.o: stdlib_kinds.o stdlib_bitsets.o: stdlib_kinds.o stdlib_bitsets_64.o: stdlib_bitsets.o stdlib_bitsets_large.o: stdlib_bitsets.o @@ -114,6 +112,9 @@ stdlib_stats_var.o: \ stdlib_stats_distribution_PRNG.o: \ stdlib_kinds.o \ stdlib_error.o -stdlib_string_type.o: stdlib_ascii.o stdlib_kinds.o -stdlib_strings.o: stdlib_ascii.o stdlib_string_type.o +stdlib_string_type.o: stdlib_ascii.o \ + stdlib_kinds.o +stdlib_strings.o: stdlib_ascii.o \ + stdlib_string_type.o \ + stdlib_math.o stdlib_math.o: stdlib_kinds.o diff --git a/src/stdlib_ascii.fypp b/src/stdlib_ascii.fypp index 641412e7f..ce7257d01 100644 --- a/src/stdlib_ascii.fypp +++ b/src/stdlib_ascii.fypp @@ -6,7 +6,6 @@ !> The specification of this module is available [here](../page/specs/stdlib_ascii.html). module stdlib_ascii use stdlib_kinds, only : int8, int16, int32, int64 - use stdlib_math, only: clip implicit none private @@ -21,7 +20,7 @@ module stdlib_ascii ! Character conversion functions public :: to_lower, to_upper, to_title, to_sentence, reverse - public :: to_string, slice + public :: to_string !> Version: experimental !> @@ -361,59 +360,6 @@ contains end function reverse - pure function slice(string, first, last, stride, include_last) result(sliced_string) - character(len=*), intent(in) :: string - integer, intent(in), optional :: first, last, stride - logical, intent(in), optional :: include_last - integer :: first_index, last_index, stride_vector, n, i, j - character(len=:), allocatable :: sliced_string - - first_index = 1 - last_index = len(string) - stride_vector = 1 - if (len(string) > 0) then - if (present(stride)) then - if (stride /= 0) then - if (stride < 0) then - first_index = len(string) - last_index = 1 - end if - stride_vector = stride - end if - else - if (present(first) .and. present(last)) then - if (last < first) then - stride_vector = -1 - end if - end if - end if - - if (present(first)) then - first_index = clip(first, 1, len(string)) - end if - if (present(last)) then - last_index = clip(last, 1, len(string)) - end if - - n = int((last_index - first_index) / stride_vector) - allocate(character(len=max(0, n + 1)) :: sliced_string) - - if (present(include_last)) then - if (include_last) then - first_index = last_index - (n * stride_vector) - end if - end if - - j = 1 - do i = first_index, last_index, stride_vector - sliced_string(j:j) = string(i:i) - j = j + 1 - end do - else - sliced_string = '' - end if - end function slice - #:for kind in INT_KINDS !> Represent an integer of kind ${kind}$ as character sequence pure function to_string_integer_${kind}$(val) result(string) diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index 0bc83f9ce..8846fa066 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -6,11 +6,13 @@ module stdlib_strings use stdlib_ascii, only : whitespace use stdlib_string_type, only : string_type, char, verify + use stdlib_math, only: clip implicit none private public :: strip, chomp public :: starts_with, ends_with + public :: slice !> Remove leading and trailing whitespace characters. @@ -56,7 +58,13 @@ module stdlib_strings module procedure :: ends_with_string_char module procedure :: ends_with_char_string module procedure :: ends_with_char_char - end interface ends_with + end interface + + !> + interface slice + module procedure :: slice_string + module procedure :: slice_char + end interface slice contains @@ -290,5 +298,72 @@ elemental function ends_with_string_string(string, substring) result(match) end function ends_with_string_string + !> Slices the region between first and last indexes of the input + !> string by taking strides of length stride + elemental function slice_string(string, first, last, stride, include_last) result(sliced_string) + type(string_type), intent(in) :: string + integer, intent(in), optional :: first, last, stride + logical, intent(in), optional :: include_last + type(string_type) :: sliced_string + + sliced_string = string_type(slice(char(string), first, last, stride, include_last)) + + end function slice_string + + !> Slices the region between first and last indexes of the input + !> character sequence by taking strides of length stride + pure function slice_char(string, first, last, stride, include_last) result(sliced_string) + character(len=*), intent(in) :: string + integer, intent(in), optional :: first, last, stride + logical, intent(in), optional :: include_last + integer :: first_index, last_index, stride_vector, n, i, j + character(len=:), allocatable :: sliced_string + + first_index = 1 + last_index = len(string) + stride_vector = 1 + if (len(string) > 0) then + if (present(stride)) then + if (stride /= 0) then + if (stride < 0) then + first_index = len(string) + last_index = 1 + end if + stride_vector = stride + end if + else + if (present(first) .and. present(last)) then + if (last < first) then + stride_vector = -1 + end if + end if + end if + + if (present(first)) then + first_index = clip(first, 1, len(string)) + end if + if (present(last)) then + last_index = clip(last, 1, len(string)) + end if + + n = int((last_index - first_index) / stride_vector) + allocate(character(len=max(0, n + 1)) :: sliced_string) + + if (present(include_last)) then + if (include_last) then + first_index = last_index - (n * stride_vector) + end if + end if + + j = 1 + do i = first_index, last_index, stride_vector + sliced_string(j:j) = string(i:i) + j = j + 1 + end do + else + sliced_string = '' + end if + end function slice_char + end module stdlib_strings From c7c1e4879d3f60de1c64c3998acfa785cff1e545 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 26 May 2021 00:14:32 +0530 Subject: [PATCH 06/18] removed include_last functionality --- src/stdlib_strings.f90 | 37 +++++++++++++++++-------------------- 1 file changed, 17 insertions(+), 20 deletions(-) diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index 8846fa066..6d3a74226 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -58,9 +58,11 @@ module stdlib_strings module procedure :: ends_with_string_char module procedure :: ends_with_char_string module procedure :: ends_with_char_char - end interface + end interface ends_with + !> Slices the input string to return a new string !> + !> Version: experimental interface slice module procedure :: slice_string module procedure :: slice_char @@ -298,31 +300,32 @@ elemental function ends_with_string_string(string, substring) result(match) end function ends_with_string_string - !> Slices the region between first and last indexes of the input - !> string by taking strides of length stride - elemental function slice_string(string, first, last, stride, include_last) result(sliced_string) + !> Slices the region between the input 'first' and 'last' index (both inclusive) + !> of the input 'string' by taking strides of length 'stride' + !> Returns a new string_type object + elemental function slice_string(string, first, last, stride) result(sliced_string) type(string_type), intent(in) :: string integer, intent(in), optional :: first, last, stride - logical, intent(in), optional :: include_last type(string_type) :: sliced_string - sliced_string = string_type(slice(char(string), first, last, stride, include_last)) + sliced_string = string_type(slice(char(string), first, last, stride)) end function slice_string - !> Slices the region between first and last indexes of the input - !> character sequence by taking strides of length stride - pure function slice_char(string, first, last, stride, include_last) result(sliced_string) + !> Slices the region between the input 'first' and 'last' index (both inclusive) + !> of the input 'string' by taking strides of length 'stride' + !> Returns a new string + pure function slice_char(string, first, last, stride) result(sliced_string) character(len=*), intent(in) :: string integer, intent(in), optional :: first, last, stride - logical, intent(in), optional :: include_last integer :: first_index, last_index, stride_vector, n, i, j character(len=:), allocatable :: sliced_string - first_index = 1 - last_index = len(string) - stride_vector = 1 if (len(string) > 0) then + first_index = 1 + last_index = len(string) + stride_vector = 1 + if (present(stride)) then if (stride /= 0) then if (stride < 0) then @@ -348,12 +351,6 @@ pure function slice_char(string, first, last, stride, include_last) result(slice n = int((last_index - first_index) / stride_vector) allocate(character(len=max(0, n + 1)) :: sliced_string) - - if (present(include_last)) then - if (include_last) then - first_index = last_index - (n * stride_vector) - end if - end if j = 1 do i = first_index, last_index, stride_vector @@ -361,7 +358,7 @@ pure function slice_char(string, first, last, stride, include_last) result(slice j = j + 1 end do else - sliced_string = '' + sliced_string = "" end if end function slice_char From ac607f1c1f551486ad657c2631e4484244fb375c Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 26 May 2021 00:15:42 +0530 Subject: [PATCH 07/18] added tests for slice function (with no include_last functionality) --- src/tests/string/test_string_functions.f90 | 37 ++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index e7157697d..18fb35c46 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -3,6 +3,7 @@ module test_string_functions use stdlib_error, only : check use stdlib_string_type, only : string_type, assignment(=), operator(==), & to_lower, to_upper, to_title, to_sentence, reverse + use stdlib_strings, only: slice implicit none contains @@ -52,6 +53,41 @@ subroutine test_reverse_string end subroutine test_reverse_string + subroutine test_slice_string + type(string_type) :: test_string + test_string = "abcdefghijklmnopqrstuvwxyz" + + call check(slice(test_string, 2, 16, 3) == "behkn", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 15, stride=-1) == "onmlkjihgfedcba", & + 'function slice failed', warn=.false.) + call check(slice(test_string, last=22, stride=-1) == "zyxwv", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 7, 2) == "gfedcb", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 7, 2, 1) == "", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 2, 6, -1) == "", & + 'function slice failed', warn=.false.) + call check(slice(test_string, stride=-1) == "zyxwvutsrqponmlkjihgfedcba", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 7, 7, -4) == "g", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 7, 7, 3) == "g", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 7, 7, 3) == "g", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 7, -10) == "gfedcba", & + 'function slice failed', warn=.false.) + call check(slice(test_string, 500, 22) == "zyxwv", & + 'function slice failed', warn=.false.) + + test_string = "" + call check(slice(test_string, 2, 16, 3) == "", & + 'function slice failed', warn=.false.) + + end subroutine test_slice_string + end module test_string_functions @@ -64,5 +100,6 @@ program tester call test_to_title_string call test_to_sentence_string call test_reverse_string + call test_slice_string end program tester From 9d72c693dc5eed623a66ffc2a5607a27b8feb6d1 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 26 May 2021 00:26:43 +0530 Subject: [PATCH 08/18] made complete use of slice interface: added test cases for character sequence --- src/tests/string/test_string_functions.f90 | 41 ++++++++++++---------- 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index 18fb35c46..9b1f0ef10 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -55,36 +55,41 @@ end subroutine test_reverse_string subroutine test_slice_string type(string_type) :: test_string + character(len=:), allocatable :: test_char test_string = "abcdefghijklmnopqrstuvwxyz" + test_char = "abcdefghijklmnopqrstuvwxyz" call check(slice(test_string, 2, 16, 3) == "behkn", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 15, stride=-1) == "onmlkjihgfedcba", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) + call check(slice(test_char, 15, stride=-1) == "onmlkjihgfedcba", & + 'function slice failed', warn=.true.) call check(slice(test_string, last=22, stride=-1) == "zyxwv", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 7, 2) == "gfedcb", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) + call check(slice(test_char, 7, 2) == "gfedcb", & + 'function slice failed', warn=.true.) call check(slice(test_string, 7, 2, 1) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 2, 6, -1) == "", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) + call check(slice(test_char, 2, 6, -1) == "", & + 'function slice failed', warn=.true.) call check(slice(test_string, stride=-1) == "zyxwvutsrqponmlkjihgfedcba", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) call check(slice(test_string, 7, 7, -4) == "g", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) + call check(slice(test_char, 7, 7, 3) == "g", & + 'function slice failed', warn=.true.) call check(slice(test_string, 7, 7, 3) == "g", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 7, 7, 3) == "g", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 7, -10) == "gfedcba", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) + call check(slice(test_char, 7, -10) == "gfedcba", & + 'function slice failed', warn=.true.) call check(slice(test_string, 500, 22) == "zyxwv", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) test_string = "" + test_char = "" call check(slice(test_string, 2, 16, 3) == "", & - 'function slice failed', warn=.false.) + 'function slice failed', warn=.true.) + call check(slice(test_char, 2, 16, 3) == "", & + 'function slice failed', warn=.true.) end subroutine test_slice_string From a733bc3b72f3a5902cdecbc9c5c4c98d056ed9d1 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Wed, 26 May 2021 13:50:42 +0530 Subject: [PATCH 09/18] documented function slice, corrected documentation of to_title and to_sentence --- doc/specs/stdlib_string_type.md | 4 +-- doc/specs/stdlib_strings.md | 61 +++++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_string_type.md b/doc/specs/stdlib_string_type.md index 76f5cd5c4..3a809171e 100644 --- a/doc/specs/stdlib_string_type.md +++ b/doc/specs/stdlib_string_type.md @@ -1254,7 +1254,7 @@ The result is a scalar `string_type` value. ```fortran program demo_to_title - use stdlib_string_type, only: string_type, to_title + use stdlib_string_type implicit none type(string_type) :: string, titlecase_string @@ -1302,7 +1302,7 @@ The result is a scalar `string_type` value. ```fortran program demo_to_sentence - use stdlib_string_type, only: string_type, to_sentence + use stdlib_string_type implicit none type(string_type) :: string, sentencecase_string diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 2b29f3d58..ce6c6c21a 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -192,3 +192,64 @@ program demo print'(a)', ends_with("pattern", "pat") ! F end program demo ``` + + + +### `slice` + +#### Description + +Extracts the characters from the defined region of the input string. +Argument `first` and `last` defines the region for the function `slice` to operate. +Extraction starts from the index `first` and takes stride of length `stride`. +Argument `stride` cannot take the value 0. + +#### Syntax + +`string = [[stdlib_strings(module):slice(interface)]] (string, first, last, stride)` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `string`: Character scalar or [[stdlib_string_type(module):string_type(type)]] + This argument is intent(in). +- `first`: integer + This argument is intent(in) and optional. +- `last`: integer + This argument is intent(in) and optional. +- `stride`: integer + This argument is intent(in) and optional. + +#### Result value + +The result is of the same type as `string`. + +#### Example + +```fortran +program demo_slice + use stdlib_string_type + use stdlib_strings, only : slice + implicit none + type(string_type) :: string + character(len=10) :: char + + string = "abcdefghij" + ! string <-- "abcdefghij" + + char = "abcdefghij" + ! char <-- "abcdefghij" + + print'(a)', slice("abcdefghij", 2, 6, 2) ! "bdf" + print'(a)', slice(string, 2, 6, 2) ! "bdf" + print'(a)', slice(char, 2, 6, 2) ! "bdf" + +end program demo_slice +``` From fa88905962f695d7eb390aa47a0d24c998f7d462 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Thu, 27 May 2021 17:57:13 +0530 Subject: [PATCH 10/18] improved function slice for invalid cases, added new invalid test cases --- src/stdlib_strings.f90 | 39 +++++++++++++------- src/tests/string/test_string_functions.f90 | 42 ++++++++++++++-------- 2 files changed, 53 insertions(+), 28 deletions(-) diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index 6d3a74226..b1afbb9c4 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -318,18 +318,19 @@ end function slice_string pure function slice_char(string, first, last, stride) result(sliced_string) character(len=*), intent(in) :: string integer, intent(in), optional :: first, last, stride - integer :: first_index, last_index, stride_vector, n, i, j + integer :: first_index, last_index, stride_vector, strides_taken, length_string, i, j character(len=:), allocatable :: sliced_string - if (len(string) > 0) then + length_string = len(string) + if (length_string > 0) then first_index = 1 - last_index = len(string) + last_index = length_string stride_vector = 1 if (present(stride)) then if (stride /= 0) then if (stride < 0) then - first_index = len(string) + first_index = length_string last_index = 1 end if stride_vector = stride @@ -343,20 +344,32 @@ pure function slice_char(string, first, last, stride) result(sliced_string) end if if (present(first)) then - first_index = clip(first, 1, len(string)) + first_index = first end if if (present(last)) then - last_index = clip(last, 1, len(string)) + last_index = last end if - n = int((last_index - first_index) / stride_vector) - allocate(character(len=max(0, n + 1)) :: sliced_string) + strides_taken = floor( real(last_index - first_index) / real(stride_vector) ) - j = 1 - do i = first_index, last_index, stride_vector - sliced_string(j:j) = string(i:i) - j = j + 1 - end do + if (strides_taken < 0 .or. & + ((first_index < 1 .and. last_index < 1) .or. & + (first_index > length_string .and. last_index > length_string))) then + + sliced_string = "" + else + first_index = clip(first_index, 1, length_string) + last_index = clip(last_index, 1, length_string) + + strides_taken = (last_index - first_index) / stride_vector + allocate(character(len=strides_taken + 1) :: sliced_string) + + j = 1 + do i = first_index, last_index, stride_vector + sliced_string(j:j) = string(i:i) + j = j + 1 + end do + end if else sliced_string = "" end if diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index 9b1f0ef10..b3bfa750b 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -60,36 +60,48 @@ subroutine test_slice_string test_char = "abcdefghijklmnopqrstuvwxyz" call check(slice(test_string, 2, 16, 3) == "behkn", & - 'function slice failed', warn=.true.) - call check(slice(test_char, 15, stride=-1) == "onmlkjihgfedcba", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) + call check(slice(test_char, first=15, stride=-1) == "onmlkjihgfedcba", & + 'function slice failed', warn=.false.) call check(slice(test_string, last=22, stride=-1) == "zyxwv", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_char, 7, 2) == "gfedcb", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_string, 7, 2, 1) == "", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_char, 2, 6, -1) == "", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_string, stride=-1) == "zyxwvutsrqponmlkjihgfedcba", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_string, 7, 7, -4) == "g", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_char, 7, 7, 3) == "g", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_string, 7, 7, 3) == "g", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_char, 7, -10) == "gfedcba", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_string, 500, 22) == "zyxwv", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) + call check(slice(test_char, 50, 27) == "", & + 'function slice failed', warn=.false.) + call check(slice(test_string, -20, -200) == "", & + 'function slice failed', warn=.false.) + call check(slice(test_char, first=0, stride=-1) == "", & + 'function slice failed', warn=.false.) + call check(slice(test_string, last=27, stride=-2) == "", & + 'function slice failed', warn=.false.) + call check(slice(test_char, first=27, stride=2) == "", & + 'function slice failed', warn=.false.) + call check(slice(test_string, -500, 500) == "abcdefghijklmnopqrstuvwxyz", & + 'function slice failed', warn=.false.) test_string = "" test_char = "" call check(slice(test_string, 2, 16, 3) == "", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) call check(slice(test_char, 2, 16, 3) == "", & - 'function slice failed', warn=.true.) + 'function slice failed', warn=.false.) end subroutine test_slice_string From 42a905df02bfa555a157c8d6cb415fb62221fec0 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sat, 29 May 2021 01:44:25 +0530 Subject: [PATCH 11/18] improved the implementation of last commit fa88905 --- src/stdlib_strings.f90 | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index b1afbb9c4..1af30417f 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -349,27 +349,23 @@ pure function slice_char(string, first, last, stride) result(sliced_string) if (present(last)) then last_index = last end if - - strides_taken = floor( real(last_index - first_index) / real(stride_vector) ) - - if (strides_taken < 0 .or. & - ((first_index < 1 .and. last_index < 1) .or. & - (first_index > length_string .and. last_index > length_string))) then - - sliced_string = "" + + if (stride_vector > 0) then + first_index = max(first_index, 1) + last_index = min(last_index, length_string) else - first_index = clip(first_index, 1, length_string) - last_index = clip(last_index, 1, length_string) - - strides_taken = (last_index - first_index) / stride_vector - allocate(character(len=strides_taken + 1) :: sliced_string) - - j = 1 - do i = first_index, last_index, stride_vector - sliced_string(j:j) = string(i:i) - j = j + 1 - end do + first_index = min(first_index, length_string) + last_index = max(last_index, 1) end if + + strides_taken = floor( real(last_index - first_index)/real(stride_vector) ) + allocate(character(len=max(0, strides_taken + 1)) :: sliced_string) + + j = 1 + do i = first_index, last_index, stride_vector + sliced_string(j:j) = string(i:i) + j = j + 1 + end do else sliced_string = "" end if From ffcb7e44e8d4b5541ca8aabeb6ef79ae67c8c98f Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sat, 29 May 2021 20:46:23 +0530 Subject: [PATCH 12/18] removed redundant outer loop, improved documentation of slice function --- doc/specs/stdlib_strings.md | 17 ++++++-- src/stdlib_strings.f90 | 80 ++++++++++++++++++------------------- 2 files changed, 52 insertions(+), 45 deletions(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index ce6c6c21a..bd625e020 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -201,8 +201,17 @@ end program demo Extracts the characters from the defined region of the input string. Argument `first` and `last` defines the region for the function `slice` to operate. -Extraction starts from the index `first` and takes stride of length `stride`. -Argument `stride` cannot take the value 0. +If the defined region is invalid (user provides atleast one invalid index), `first` and +`last` indexes are converted to first and last valid indexes in this defined region respectively, +if no valid index exists in this region an empty string is returned. + +Extraction starts from `first` index and takes stride of length `stride`. +Extraction is active until `last` index is crossed. +Extraction starts only if `last` index is crossable from `first` index taking +stride of length `stride`. +`stride` can attain both negative or positive values but when the invalid value +0 is given, it is converted to 1. +Function automatically deduces the arguments which are not provided by the user. #### Syntax @@ -248,8 +257,10 @@ program demo_slice ! char <-- "abcdefghij" print'(a)', slice("abcdefghij", 2, 6, 2) ! "bdf" - print'(a)', slice(string, 2, 6, 2) ! "bdf" print'(a)', slice(char, 2, 6, 2) ! "bdf" + string = slice(string, 2, 6, 2) + ! string <-- "bdf" + end program demo_slice ``` diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index 1af30417f..30152eb92 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -320,55 +320,51 @@ pure function slice_char(string, first, last, stride) result(sliced_string) integer, intent(in), optional :: first, last, stride integer :: first_index, last_index, stride_vector, strides_taken, length_string, i, j character(len=:), allocatable :: sliced_string - length_string = len(string) - if (length_string > 0) then - first_index = 1 - last_index = length_string - stride_vector = 1 - - if (present(stride)) then - if (stride /= 0) then - if (stride < 0) then - first_index = length_string - last_index = 1 - end if - stride_vector = stride + + first_index = 1 + last_index = length_string + stride_vector = 1 + + if (present(stride)) then + if (stride /= 0) then + if (stride < 0) then + first_index = length_string + last_index = 1 end if - else - if (present(first) .and. present(last)) then - if (last < first) then - stride_vector = -1 - end if + stride_vector = stride + end if + else + if (present(first) .and. present(last)) then + if (last < first) then + stride_vector = -1 end if end if + end if - if (present(first)) then - first_index = first - end if - if (present(last)) then - last_index = last - end if - - if (stride_vector > 0) then - first_index = max(first_index, 1) - last_index = min(last_index, length_string) - else - first_index = min(first_index, length_string) - last_index = max(last_index, 1) - end if - - strides_taken = floor( real(last_index - first_index)/real(stride_vector) ) - allocate(character(len=max(0, strides_taken + 1)) :: sliced_string) - - j = 1 - do i = first_index, last_index, stride_vector - sliced_string(j:j) = string(i:i) - j = j + 1 - end do + if (present(first)) then + first_index = first + end if + if (present(last)) then + last_index = last + end if + + if (stride_vector > 0) then + first_index = max(first_index, 1) + last_index = min(last_index, length_string) else - sliced_string = "" + first_index = min(first_index, length_string) + last_index = max(last_index, 1) end if + + strides_taken = floor( real(last_index - first_index)/real(stride_vector) ) + allocate(character(len=max(0, strides_taken + 1)) :: sliced_string) + + j = 1 + do i = first_index, last_index, stride_vector + sliced_string(j:j) = string(i:i) + j = j + 1 + end do end function slice_char From 4598eecdb52a6432fc0459394b66ad15c4331cc5 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Sat, 29 May 2021 20:52:00 +0530 Subject: [PATCH 13/18] removed dependency of clip function by stdlib_strings.f90 --- src/Makefile.manual | 3 +-- src/stdlib_strings.f90 | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 322ddd0ae..22a5abcdb 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -115,6 +115,5 @@ stdlib_stats_distribution_PRNG.o: \ stdlib_string_type.o: stdlib_ascii.o \ stdlib_kinds.o stdlib_strings.o: stdlib_ascii.o \ - stdlib_string_type.o \ - stdlib_math.o + stdlib_string_type.o stdlib_math.o: stdlib_kinds.o diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index 30152eb92..934875e8a 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -6,7 +6,6 @@ module stdlib_strings use stdlib_ascii, only : whitespace use stdlib_string_type, only : string_type, char, verify - use stdlib_math, only: clip implicit none private @@ -321,7 +320,7 @@ pure function slice_char(string, first, last, stride) result(sliced_string) integer :: first_index, last_index, stride_vector, strides_taken, length_string, i, j character(len=:), allocatable :: sliced_string length_string = len(string) - + first_index = 1 last_index = length_string stride_vector = 1 From 24d417f85a3885abdceecede078b3bce8fae78df Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Mon, 7 Jun 2021 08:23:16 +0530 Subject: [PATCH 14/18] improved documentation and comments for function slice --- doc/specs/stdlib_strings.md | 9 ++++----- src/stdlib_strings.f90 | 8 ++++---- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index bd625e020..5fae50953 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -205,13 +205,12 @@ If the defined region is invalid (user provides atleast one invalid index), `fir `last` indexes are converted to first and last valid indexes in this defined region respectively, if no valid index exists in this region an empty string is returned. -Extraction starts from `first` index and takes stride of length `stride`. -Extraction is active until `last` index is crossed. -Extraction starts only if `last` index is crossable from `first` index taking -stride of length `stride`. `stride` can attain both negative or positive values but when the invalid value 0 is given, it is converted to 1. -Function automatically deduces the arguments which are not provided by the user. +Extraction starts from `first` index and takes stride of length `stride`. +Extraction starts only if `last` index is crossable from `first` index by taking +stride of length `stride`and is active until `last` index is crossed. +Function automatically deduces the optional arguments that are not provided by the user. #### Syntax diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index 934875e8a..913051f87 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -59,7 +59,7 @@ module stdlib_strings module procedure :: ends_with_char_char end interface ends_with - !> Slices the input string to return a new string + !> Extracts characters from the input string to return a new string !> !> Version: experimental interface slice @@ -299,9 +299,9 @@ elemental function ends_with_string_string(string, substring) result(match) end function ends_with_string_string - !> Slices the region between the input 'first' and 'last' index (both inclusive) + !> Extract the characters from the region between 'first' and 'last' index (both inclusive) !> of the input 'string' by taking strides of length 'stride' - !> Returns a new string_type object + !> Returns a new string elemental function slice_string(string, first, last, stride) result(sliced_string) type(string_type), intent(in) :: string integer, intent(in), optional :: first, last, stride @@ -311,7 +311,7 @@ elemental function slice_string(string, first, last, stride) result(sliced_strin end function slice_string - !> Slices the region between the input 'first' and 'last' index (both inclusive) + !> Extract the characters from the region between 'first' and 'last' index (both inclusive) !> of the input 'string' by taking strides of length 'stride' !> Returns a new string pure function slice_char(string, first, last, stride) result(sliced_string) From 323bcd9efb9dba8c21ff959d400a18483618a644 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 10 Jun 2021 18:08:20 +0200 Subject: [PATCH 15/18] Add general tester against intrinsic array slice --- src/tests/string/test_string_functions.f90 | 128 +++++++++++++++++++++ 1 file changed, 128 insertions(+) diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index b3bfa750b..2380cdff1 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -1,9 +1,12 @@ ! SPDX-Identifier: MIT module test_string_functions + use, intrinsic :: iso_fortran_env, only : error_unit use stdlib_error, only : check use stdlib_string_type, only : string_type, assignment(=), operator(==), & to_lower, to_upper, to_title, to_sentence, reverse use stdlib_strings, only: slice + use stdlib_optval, only: optval + use stdlib_ascii, only : to_string implicit none contains @@ -105,6 +108,130 @@ subroutine test_slice_string end subroutine test_slice_string + subroutine test_slice_gen + character(len=*), parameter :: test = & + & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" + integer :: i, j, k + integer, parameter :: offset = 3 + + do i = 1 - offset, len(test) + offset + call check_slicer(test, first=i) + end do + + do i = 1 - offset, len(test) + offset + call check_slicer(test, last=i) + end do + + do i = -len(test) - offset, len(test) + offset + call check_slicer(test, stride=i) + end do + + do i = 1 - offset, len(test) + offset + do j = 1 - offset, len(test) + offset + call check_slicer(test, first=i, last=j) + end do + end do + + do i = 1 - offset, len(test) + offset + do j = -len(test) - offset, len(test) + offset + call check_slicer(test, first=i, stride=j) + end do + end do + + do i = 1 - offset, len(test) + offset + do j = -len(test) - offset, len(test) + offset + call check_slicer(test, last=i, stride=j) + end do + end do + + do i = 1 - offset, len(test) + offset + do j = 1 - offset, len(test) + offset + do k = -len(test) - offset, len(test) + offset + call check_slicer(test, first=i, last=j, stride=k) + end do + end do + end do + end subroutine test_slice_gen + + subroutine check_slicer(string, first, last, stride) + character(len=*), intent(in) :: string + integer, intent(in), optional :: first + integer, intent(in), optional :: last + integer, intent(in), optional :: stride + + character(len=:), allocatable :: actual, expected, message + logical :: stat + + actual = slice(string, first, last, stride) + expected = reference_slice(string, first, last, stride) + + stat = actual == expected + + if (.not.stat) then + message = "For input '"//string//"'"//new_line('a') + + if (present(first)) then + message = message // "first: "//to_string(first)//new_line('a') + end if + if (present(last)) then + message = message // "last: "//to_string(last)//new_line('a') + end if + if (present(stride)) then + message = message // "stride: "//to_string(stride)//new_line('a') + end if + message = message // "Expected: '"//expected//"' but got '"//actual//"'" + end if + call check(stat, message) + + end subroutine check_slicer + + pure function reference_slice(string, first, last, stride) result(sliced_string) + character(len=*), intent(in) :: string + integer, intent(in), optional :: first + integer, intent(in), optional :: last + integer, intent(in), optional :: stride + character(len=:), allocatable :: sliced_string + character(len=1), allocatable :: carray(:) + + integer :: first_, last_, stride_ + + stride_ = 1 + if (present(stride)) then + stride_ = merge(stride_, stride, stride == 0) + else + if (present(first) .and. present(last)) then + if (last < first) stride_ = -1 + end if + end if + + if (stride_ < 0) then + last_ = min(max(optval(last, 1), 1), len(string)+1) + first_ = min(max(optval(first, len(string)), 0), len(string)) + else + first_ = min(max(optval(first, 1), 1), len(string)+1) + last_ = min(max(optval(last, len(string)), 0), len(string)) + end if + + carray = string_to_carray(string) + carray = carray(first_:last_:stride_) + sliced_string = carray_to_string(carray) + + end function reference_slice + + pure function string_to_carray(string) result(carray) + character(len=*), intent(in) :: string + character(len=1) :: carray(len(string)) + + carray = transfer(string, carray) + end function string_to_carray + + pure function carray_to_string(carray) result(string) + character(len=1), intent(in) :: carray(:) + character(len=size(carray)) :: string + + string = transfer(carray, string) + end function carray_to_string + end module test_string_functions @@ -118,5 +245,6 @@ program tester call test_to_sentence_string call test_reverse_string call test_slice_string + call test_slice_gen end program tester From d60dad35f817cb2e55bdca1857085b99da1f0fad Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 11 Jun 2021 17:28:11 +0530 Subject: [PATCH 16/18] added -inf and +inf concept to make code more intuitive, added descriptive comments to the test cases --- src/stdlib_strings.f90 | 8 +- src/tests/string/test_string_functions.f90 | 101 ++++++++++++--------- 2 files changed, 61 insertions(+), 48 deletions(-) diff --git a/src/stdlib_strings.f90 b/src/stdlib_strings.f90 index 913051f87..158b06588 100644 --- a/src/stdlib_strings.f90 +++ b/src/stdlib_strings.f90 @@ -321,15 +321,15 @@ pure function slice_char(string, first, last, stride) result(sliced_string) character(len=:), allocatable :: sliced_string length_string = len(string) - first_index = 1 - last_index = length_string + first_index = 0 ! first_index = -infinity + last_index = length_string + 1 ! last_index = +infinity stride_vector = 1 if (present(stride)) then if (stride /= 0) then if (stride < 0) then - first_index = length_string - last_index = 1 + first_index = length_string + 1 ! first_index = +infinity + last_index = 0 ! last_index = -infinity end if stride_vector = stride end if diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index 2380cdff1..605eb2b2c 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -58,53 +58,66 @@ end subroutine test_reverse_string subroutine test_slice_string type(string_type) :: test_string - character(len=:), allocatable :: test_char test_string = "abcdefghijklmnopqrstuvwxyz" - test_char = "abcdefghijklmnopqrstuvwxyz" - - call check(slice(test_string, 2, 16, 3) == "behkn", & - 'function slice failed', warn=.false.) - call check(slice(test_char, first=15, stride=-1) == "onmlkjihgfedcba", & - 'function slice failed', warn=.false.) - call check(slice(test_string, last=22, stride=-1) == "zyxwv", & - 'function slice failed', warn=.false.) - call check(slice(test_char, 7, 2) == "gfedcb", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 7, 2, 1) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_char, 2, 6, -1) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_string, stride=-1) == "zyxwvutsrqponmlkjihgfedcba", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 7, 7, -4) == "g", & - 'function slice failed', warn=.false.) - call check(slice(test_char, 7, 7, 3) == "g", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 7, 7, 3) == "g", & - 'function slice failed', warn=.false.) - call check(slice(test_char, 7, -10) == "gfedcba", & - 'function slice failed', warn=.false.) - call check(slice(test_string, 500, 22) == "zyxwv", & - 'function slice failed', warn=.false.) - call check(slice(test_char, 50, 27) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_string, -20, -200) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_char, first=0, stride=-1) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_string, last=27, stride=-2) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_char, first=27, stride=2) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_string, -500, 500) == "abcdefghijklmnopqrstuvwxyz", & - 'function slice failed', warn=.false.) + ! Only one argument is given + ! Valid + call check(slice(test_string, first=10) == "jklmnopqrstuvwxyz") ! last=+inf + call check(slice(test_string, last=10) == "abcdefghij") ! first=-inf + call check(slice(test_string, stride=3) == "adgjmpsvy") ! first=-inf, last=+inf + call check(slice(test_string, stride=-3) == "zwtqnkheb") ! first=+inf, last=-inf + + ! Invalid + call check(slice(test_string, first=27) == "") ! last=+inf + call check(slice(test_string, first=-10) == "abcdefghijklmnopqrstuvwxyz") ! last=+inf + call check(slice(test_string, last=-2) == "") ! first=-inf + call check(slice(test_string, last=30) == "abcdefghijklmnopqrstuvwxyz") ! first=-inf + call check(slice(test_string, stride=0) == "abcdefghijklmnopqrstuvwxyz") ! stride=1 + + ! Only two arguments are given + ! Valid + call check(slice(test_string, first=10, last=20) == "jklmnopqrst") + call check(slice(test_string, first=7, last=2) == "gfedcb") ! stride=-1 + call check(slice(test_string, first=10, stride=-2) == "jhfdb") ! last=-inf + call check(slice(test_string, last=21, stride=-2) == "zxv") ! first=+inf + + ! Atleast one argument is invalid + call check(slice(test_string, first=30, last=-3) == "zyxwvutsrqponmlkjihgfedcba") + call check(slice(test_string, first=1, last=-20) == "a") + call check(slice(test_string, first=7, last=-10) == "gfedcba") + call check(slice(test_string, first=500, last=22) == "zyxwv") + call check(slice(test_string, first=50, last=27) == "") + call check(slice(test_string, first=-20, last=0) == "") + call check(slice(test_string, last=-3, stride=-2) == "zxvtrpnljhfdb") ! first=+inf + call check(slice(test_string, last=10, stride=0) == "abcdefghij") ! stride=1 + call check(slice(test_string, first=-2, stride=-2) == "") ! last=-inf + call check(slice(test_string, first=27, stride=2) == "") ! last=+inf + call check(slice(test_string, last=27, stride=-1) == "") ! first=+inf + + ! All three arguments are given + ! Valid + call check(slice(test_string, first=2, last=16, stride=3) == "behkn") + call check(slice(test_string, first=16, last=2, stride=-3) == "pmjgd") + call check(slice(test_string, first=7, last=7, stride=-4) == "g") + call check(slice(test_string, first=7, last=7, stride=3) == "g") + call check(slice(test_string, first=2, last=6, stride=-1) == "") + call check(slice(test_string, first=20, last=10, stride=2) == "") + + ! Invalid + call check(slice(test_string, first=20, last=30, stride=2) == "tvxz") + call check(slice(test_string, first=-20, last=30, stride=2) == "acegikmoqsuwy") + call check(slice(test_string, first=26, last=30, stride=1) == "z") + call check(slice(test_string, first=1, last=-20, stride=-1) == "a") + call check(slice(test_string, first=26, last=20, stride=1) == "") + call check(slice(test_string, first=1, last=20, stride=-1) == "") + test_string = "" - test_char = "" - call check(slice(test_string, 2, 16, 3) == "", & - 'function slice failed', warn=.false.) - call check(slice(test_char, 2, 16, 3) == "", & - 'function slice failed', warn=.false.) + ! Empty string input + call check(slice(test_string, first=-2, last=6) == "") + call check(slice(test_string, first=6, last=-2) == "") + call check(slice(test_string, first=-10) == "") ! last=+inf + call check(slice(test_string, last=10) == "") ! first=-inf + call check(slice(test_string) == "") end subroutine test_slice_string From 048b638b5dd918807b9e57ce3d4b5fe1e9b81ab9 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 11 Jun 2021 18:43:26 +0530 Subject: [PATCH 17/18] added the concept of +inf and -inf in documentation --- doc/specs/stdlib_strings.md | 27 ++++++++++++++-------- src/tests/string/test_string_functions.f90 | 2 +- 2 files changed, 18 insertions(+), 11 deletions(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 5fae50953..c047653b5 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -199,18 +199,25 @@ end program demo #### Description -Extracts the characters from the defined region of the input string. -Argument `first` and `last` defines the region for the function `slice` to operate. -If the defined region is invalid (user provides atleast one invalid index), `first` and -`last` indexes are converted to first and last valid indexes in this defined region respectively, +Extracts the characters from the defined region of the input string by taking strides. + +Deduction Process: +Function first automatically deduces the optional arguments that are not provided by the user. +This process is independent of both input `string` and permitted indexes of Fortran. +Deduced `first` and `last` argument take +infinity or -infinity value whereas deduced `stride` argument takes +1 or -1 value. + +Validation Process: +Argument `first` and `last` defines this region for extraction by function `slice`. +If the defined region is invalid i.e. region contains atleast one invalid index, `first` and +`last` are converted to first and last valid indexes in this defined region respectively, if no valid index exists in this region an empty string is returned. +`stride` can attain both negative or positive values but when the only invalid value +0 is given, it is converted to 1. -`stride` can attain both negative or positive values but when the invalid value -0 is given, it is converted to 1. -Extraction starts from `first` index and takes stride of length `stride`. -Extraction starts only if `last` index is crossable from `first` index by taking -stride of length `stride`and is active until `last` index is crossed. -Function automatically deduces the optional arguments that are not provided by the user. +Extraction Process: +After all this, extraction starts from `first` index and takes stride of length `stride`. +Extraction starts only if `last` index is crossable from `first` index with stride `stride` +and remains active until `last` index is crossed. #### Syntax diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index 605eb2b2c..de636b762 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -103,7 +103,7 @@ subroutine test_slice_string call check(slice(test_string, first=2, last=6, stride=-1) == "") call check(slice(test_string, first=20, last=10, stride=2) == "") - ! Invalid + ! Atleast one argument is invalid call check(slice(test_string, first=20, last=30, stride=2) == "tvxz") call check(slice(test_string, first=-20, last=30, stride=2) == "acegikmoqsuwy") call check(slice(test_string, first=26, last=30, stride=1) == "z") From d38e0f4410e042a92b105f73a0df0f067b965698 Mon Sep 17 00:00:00 2001 From: Aman-Godara Date: Fri, 11 Jun 2021 21:05:01 +0530 Subject: [PATCH 18/18] added fail messages to unit tests --- src/tests/string/test_string_functions.f90 | 123 ++++++++++++++------- 1 file changed, 82 insertions(+), 41 deletions(-) diff --git a/src/tests/string/test_string_functions.f90 b/src/tests/string/test_string_functions.f90 index de636b762..e72b4c162 100644 --- a/src/tests/string/test_string_functions.f90 +++ b/src/tests/string/test_string_functions.f90 @@ -62,62 +62,103 @@ subroutine test_slice_string ! Only one argument is given ! Valid - call check(slice(test_string, first=10) == "jklmnopqrstuvwxyz") ! last=+inf - call check(slice(test_string, last=10) == "abcdefghij") ! first=-inf - call check(slice(test_string, stride=3) == "adgjmpsvy") ! first=-inf, last=+inf - call check(slice(test_string, stride=-3) == "zwtqnkheb") ! first=+inf, last=-inf + call check(slice(test_string, first=10) == "jklmnopqrstuvwxyz", & + "Slice, Valid arguments: first=10") ! last=+inf + call check(slice(test_string, last=10) == "abcdefghij", & + "Slice, Valid arguments: last=10") ! first=-inf + call check(slice(test_string, stride=3) == "adgjmpsvy", & + "Slice, Valid arguments: stride=3") ! first=-inf, last=+inf + call check(slice(test_string, stride=-3) == "zwtqnkheb", & + "Slice, Valid arguments: stride=-3") ! first=+inf, last=-inf ! Invalid - call check(slice(test_string, first=27) == "") ! last=+inf - call check(slice(test_string, first=-10) == "abcdefghijklmnopqrstuvwxyz") ! last=+inf - call check(slice(test_string, last=-2) == "") ! first=-inf - call check(slice(test_string, last=30) == "abcdefghijklmnopqrstuvwxyz") ! first=-inf - call check(slice(test_string, stride=0) == "abcdefghijklmnopqrstuvwxyz") ! stride=1 + call check(slice(test_string, first=27) == "", & + "Slice, Invalid arguments: first=27") ! last=+inf + call check(slice(test_string, first=-10) == "abcdefghijklmnopqrstuvwxyz", & + "Slice, Invalid arguments: first=-10") ! last=+inf + call check(slice(test_string, last=-2) == "", & + "Slice, Invalid arguments: last=-2") ! first=-inf + call check(slice(test_string, last=30) == "abcdefghijklmnopqrstuvwxyz", & + "Slice, Invalid arguments: last=30") ! first=-inf + call check(slice(test_string, stride=0) == "abcdefghijklmnopqrstuvwxyz", & + "Slice, Invalid arguments: stride=0") ! stride=1 ! Only two arguments are given ! Valid - call check(slice(test_string, first=10, last=20) == "jklmnopqrst") - call check(slice(test_string, first=7, last=2) == "gfedcb") ! stride=-1 - call check(slice(test_string, first=10, stride=-2) == "jhfdb") ! last=-inf - call check(slice(test_string, last=21, stride=-2) == "zxv") ! first=+inf + call check(slice(test_string, first=10, last=20) == "jklmnopqrst", & + "Slice, Valid arguments: first=10, last=20") + call check(slice(test_string, first=7, last=2) == "gfedcb", & + "Slice, Valid arguments: first=7, last=2") ! stride=-1 + call check(slice(test_string, first=10, stride=-2) == "jhfdb", & + "Slice, Valid arguments: first=10, stride=-2") ! last=-inf + call check(slice(test_string, last=21, stride=-2) == "zxv", & + "Slice, Valid arguments: last=21, stride=-2") ! first=+inf ! Atleast one argument is invalid - call check(slice(test_string, first=30, last=-3) == "zyxwvutsrqponmlkjihgfedcba") - call check(slice(test_string, first=1, last=-20) == "a") - call check(slice(test_string, first=7, last=-10) == "gfedcba") - call check(slice(test_string, first=500, last=22) == "zyxwv") - call check(slice(test_string, first=50, last=27) == "") - call check(slice(test_string, first=-20, last=0) == "") - call check(slice(test_string, last=-3, stride=-2) == "zxvtrpnljhfdb") ! first=+inf - call check(slice(test_string, last=10, stride=0) == "abcdefghij") ! stride=1 - call check(slice(test_string, first=-2, stride=-2) == "") ! last=-inf - call check(slice(test_string, first=27, stride=2) == "") ! last=+inf - call check(slice(test_string, last=27, stride=-1) == "") ! first=+inf + call check(slice(test_string, first=30, last=-3) == "zyxwvutsrqponmlkjihgfedcba", & + "Slice, Invalid arguments: first=30, last=-3") + call check(slice(test_string, first=1, last=-20) == "a", & + "Slice, Invalid arguments: first=1, last=-20") + call check(slice(test_string, first=7, last=-10) == "gfedcba", & + "Slice, Invalid arguments: first=7, last=-10") + call check(slice(test_string, first=500, last=22) == "zyxwv", & + "Slice, Invalid arguments: first=500, last=22") + call check(slice(test_string, first=50, last=27) == "", & + "Slice, Invalid arguments: first=50, last=27") + call check(slice(test_string, first=-20, last=0) == "", & + "Slice, Invalid arguments: first=-20, last=0") + call check(slice(test_string, last=-3, stride=-2) == "zxvtrpnljhfdb", & + "Slice, Invalid arguments: last=-3, stride=-2") ! first=+inf + call check(slice(test_string, last=10, stride=0) == "abcdefghij", & + "Slice, Invalid arguments: last=10, stride=0") ! stride=1 + call check(slice(test_string, first=-2, stride=-2) == "", & + "Slice, Invalid arguments: first=-2, stride=-2") ! last=-inf + call check(slice(test_string, first=27, stride=2) == "", & + "Slice, Invalid arguments: first=27, stride=2") ! last=+inf + call check(slice(test_string, last=27, stride=-1) == "", & + "Slice, Invalid arguments: last=27, stride=-1") ! first=+inf ! All three arguments are given ! Valid - call check(slice(test_string, first=2, last=16, stride=3) == "behkn") - call check(slice(test_string, first=16, last=2, stride=-3) == "pmjgd") - call check(slice(test_string, first=7, last=7, stride=-4) == "g") - call check(slice(test_string, first=7, last=7, stride=3) == "g") - call check(slice(test_string, first=2, last=6, stride=-1) == "") - call check(slice(test_string, first=20, last=10, stride=2) == "") + call check(slice(test_string, first=2, last=16, stride=3) == "behkn", & + "Slice, Valid arguments: first=2, last=16, stride=3") + call check(slice(test_string, first=16, last=2, stride=-3) == "pmjgd", & + "Slice, Valid arguments: first=16, last=2, stride=-3") + call check(slice(test_string, first=7, last=7, stride=-4) == "g", & + "Slice, Valid arguments: first=7, last=7, stride=-4") + call check(slice(test_string, first=7, last=7, stride=3) == "g", & + "Slice, Valid arguments: first=7, last=7, stride=3") + call check(slice(test_string, first=2, last=6, stride=-1) == "", & + "Slice, Valid arguments: first=2, last=6, stride=-1") + call check(slice(test_string, first=20, last=10, stride=2) == "", & + "Slice, Valid arguments: first=20, last=10, stride=2") ! Atleast one argument is invalid - call check(slice(test_string, first=20, last=30, stride=2) == "tvxz") - call check(slice(test_string, first=-20, last=30, stride=2) == "acegikmoqsuwy") - call check(slice(test_string, first=26, last=30, stride=1) == "z") - call check(slice(test_string, first=1, last=-20, stride=-1) == "a") - call check(slice(test_string, first=26, last=20, stride=1) == "") - call check(slice(test_string, first=1, last=20, stride=-1) == "") + call check(slice(test_string, first=20, last=30, stride=2) == "tvxz", & + "Slice, Invalid arguments: first=20, last=30, stride=2") + call check(slice(test_string, first=-20, last=30, stride=2) == "acegikmoqsuwy", & + "Slice, Invalid arguments: first=-20, last=30, stride=2") + call check(slice(test_string, first=26, last=30, stride=1) == "z", & + "Slice, Invalid arguments: first=26, last=30, stride=1") + call check(slice(test_string, first=1, last=-20, stride=-1) == "a", & + "Slice, Invalid arguments: first=1, last=-20, stride=-1") + call check(slice(test_string, first=26, last=20, stride=1) == "", & + "Slice, Invalid arguments: first=26, last=20, stride=1") + call check(slice(test_string, first=1, last=20, stride=-1) == "", & + "Slice, Invalid arguments: first=1, last=20, stride=-1") test_string = "" ! Empty string input - call check(slice(test_string, first=-2, last=6) == "") - call check(slice(test_string, first=6, last=-2) == "") - call check(slice(test_string, first=-10) == "") ! last=+inf - call check(slice(test_string, last=10) == "") ! first=-inf - call check(slice(test_string) == "") + call check(slice(test_string, first=-2, last=6) == "", & + "Slice, Empty string: first=-2, last=6") + call check(slice(test_string, first=6, last=-2) == "", & + "Slice, Empty string: first=6, last=-2") + call check(slice(test_string, first=-10) == "", & + "Slice, Empty string: first=-10") ! last=+inf + call check(slice(test_string, last=10) == "", & + "Slice, Empty string: last=10") ! first=-inf + call check(slice(test_string) == "", & + "Slice, Empty string: no arguments provided") end subroutine test_slice_string