Merge branch 'master' of github.com:ashinn/chibi-scheme

lib/srfi/231/base.scm

@@ -22,19 +22,33 @@
                       (lp (+ i 1)))))))))
 
 (define (index-rotate n k)
+  (assert (and (exact-integer? n)
+               (exact-integer? k)
+               (< -1 k n)))
   (list->vector (append (iota (- n k) k) (iota k))))
 
 (define (index-first n k)
+  (assert (and (exact-integer? n)
+               (exact-integer? k)
+               (< -1 k n)))
   (list->vector (cons k
                       (append (iota k)
                               (iota (- n (+ k 1)) (+ k 1))))))
 
 (define (index-last n k)
+  (assert (and (exact-integer? n)
+               (exact-integer? k)
+               (< -1 k n)))
   (list->vector (append (iota k)
                         (iota (- n (+ k 1)) (+ k 1))
                         (list k))))
 
 (define (index-swap n i j)
+  (assert (and (exact-integer? n)
+               (exact-integer? i)
+               (exact-integer? j)
+               (< -1 i n)
+               (< -1 j n)))
   (let ((result (vector-iota n 0)))
     (vector-set! result i j)
     (vector-set! result j i)

lib/srfi/231/test.sld

@@ -1,6 +1,6 @@
 ;; Adapted from original SRFI reference test suite:
 
-;; SRFI 179: Nonempty Intervals and Generalized Arrays (Updated)
+;; SRFI 231: Intervals and Generalized Arrays
 
 ;; Copyright 2016, 2018, 2020 Bradley J Lucier.
 ;; All Rights Reserved.
@@ -29,8 +29,8 @@
 ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 ;; OTHER DEALINGS IN THE SOFTWARE.
 
-;;; A test program for SRFI 179:
+;;; A test program for SRFI 231:
-;;; Nonempty Intervals and Generalized Arrays (Updated)
+;;; Intervals and Generalized Arrays
 
 (define-library (srfi 231 test)
   (import (scheme base) (scheme cxr) (scheme complex)
@@ -189,10 +189,10 @@
       (zero? (random 2)))
 
     (define (array-display A)
-  
+
       (define (display-item x)
         (display x) (display "\t"))
-  
+
       (newline)
       (case (array-dimension A)
         ((1) (array-for-each display-item A) (newline))
@@ -903,7 +903,38 @@
 
       (random-source-pseudo-randomize! default-random-source 7 23)
 
-      (test-begin "srfi-179: nonempty intervals and generalized arrays")
+      (test-begin "srfi-231: nonempty intervals and generalized arrays")
+
+      (test-group "index-* and miscellaneous tests"
+        (test-error (index-first 'a 3))
+        (test-error (index-first 5 'a))
+        (test-error (index-first -1 5))
+        (test-error (index-first 0 -2))
+        (test-error (index-first 3 5))
+        (test '#(3 0 1 2 4) (index-first 5 3))
+
+        (test-error (index-last 'a 3))
+        (test-error (index-last 5 'a))
+        (test-error (index-last -1 5))
+        (test-error (index-last 0 -2))
+        (test-error (index-last 3 5))
+        (test '#(0 1 2 4 3) (index-last 5 3))
+
+        (test-error (index-rotate 'a 3))
+        (test-error (index-rotate 5 'a))
+        (test-error (index-rotate -1 5))
+        (test-error (index-rotate 0 -2))
+        (test-error (index-rotate 3 5))
+        (test '#(3 4 0 1 2) (index-rotate 5 3))
+
+        (test-error (index-swap 'a 3 0))
+        (test-error (index-swap 5 'a 0))
+        (test-error (index-swap -1 5 0))
+        (test-error (index-swap 0 -2 0))
+        (test-error (index-swap 3 5 0))
+        (test '#(3 1 2 0 4) (index-swap 5 3 0))
+
+                  )
 
       (test-group "interval tests"
         (test-error (make-interval 1 '#(3 4)))
@@ -1456,7 +1487,7 @@
         ;;            (%%array-domain curried-sampled-array)
         ;;            (%%array-indexer curried-sampled-array))
         ;;         (array-packed? curried-sampled-array))))
-         
+
         ;; FIXME: array-reshape tests.
 
         ;; error tests
@@ -3579,7 +3610,7 @@
           ;; (array-for-each (lambda (row)
           ;;                   (pretty-print (array->list row)))
           ;;                 (array-curry b 1))
-  
+
           ;; which prints
           ;; ((0 0) (0 1) (0 2) (0 3) (0 4))
           ;; ((1 1) (1 2) (1 3) (1 4) (1 5))
@@ -3650,7 +3681,7 @@
         ;;                edge-array))
         ;;    "edge-test.pgm"))
 
-      
+
         (let ((m
                (array-copy (make-array (make-interval '#(0 0) '#(40 30))
                                        (lambda (i j) (inexact (+ i j)))))))