Add general tester against intrinsic array slice

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