Add general tester against intrinsic array slice

Author: awvwgk

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