Email list hosting service & mailing list manager

Srfi-43 typo, patch & tests Shiro Kawai (05 Oct 2005 12:09 UTC)
Re: Srfi-43 typo, patch & tests Taylor Campbell (07 Oct 2005 00:26 UTC)

Srfi-43 typo, patch & tests Shiro Kawai 05 Oct 2005 12:11 UTC

While porting srfi-43 to Gauche, I found some bugs in the
reference implementation.  A patch is attached (vector-lib.scm.diff),
along the tests (vector-lib-test.scm).  The test may benefit
not only porters but also those who try to implement srfi-43
from the document.

Also there's a typo in the document.
The first example of vector-unfold should yield
   #(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)
while the current document says
   #(0 -1 -2 -3 -4 -5 -6 -7 -8 -8)

--shiro

--- vector-lib.scm.orig	2005-10-05 02:02:29.000000000 -1000
+++ vector-lib.scm	2005-10-05 01:56:30.000000000 -1000
@@ -371,15 +371,13 @@
 ;;;   Copy elements from SSTART to SEND from SOURCE to TARGET, in the
 ;;;   reverse order.
 (define %vector-reverse-copy!
-  (letrec ((loop (lambda (kons knil len vectors i)
-                   (if (= i len)
-                       knil
-                       (loop kons
-                             (apply kons i knil
-                                    (vectors-ref vectors i))
-                             len vectors (+ i 1))))))
-    (lambda (kons knil len vectors)
-      (loop kons knil len vectors 0))))
+  (letrec ((loop (lambda (target source sstart i j)
+                   (cond ((<= sstart i)
+                          (vector-set! target j
+                                       (vector-ref source i))
+                          (loop target source sstart (- i 1) (+ j 1)))))))
+    (lambda (target tstart source sstart send)
+      (loop target source sstart (- send 1) tstart))))

 ;;; (%VECTOR-REVERSE! <vector>)
 (define %vector-reverse!
@@ -805,7 +803,7 @@
                         knil
                         (loop1 kons (kons i knil (vector-ref vec i))
                                vec
-                               (+ i 1)))))
+                               (- i 1)))))
            (loop2+ (lambda (kons knil vectors i)
                      (if (negative? i)
                          knil
@@ -813,7 +811,7 @@
                                  (apply kons i knil
                                         (vectors-ref vectors i))
                                  vectors
-                                 (+ i 1))))))
+                                 (- i 1))))))
     (lambda (kons knil vec . vectors)
       (let ((kons (check-type procedure? kons vector-fold-right))
             (vec  (check-type vector?    vec  vector-fold-right)))
@@ -1013,17 +1011,19 @@
   (let ((cmp (check-type procedure? cmp vector-binary-search)))
     (let-vector-start+end vector-binary-search vec maybe-start+end
                           (start end)
-      (let loop ((start start) (end end) (j #f))
-        (let ((i (quotient (+ start end) 2)))
-          (if (and j (= i j))
-              #f
-              (let ((comparison
-                     (check-type integer?
-                                 (cmp (vector-ref vec i) value)
-                                 `(,cmp for ,vector-binary-search))))
-                (cond ((zero?     comparison) i)
-                      ((positive? comparison) (loop start i i))
-                      (else                   (loop i end i))))))))))
+      (if (= start end)
+          #f
+          (let loop ((start start) (end end) (j #f))
+            (let ((i (quotient (+ start end) 2)))
+              (if (and j (= i j))
+                #f
+                (let ((comparison
+                       (check-type integer?
+                                   (cmp (vector-ref vec i) value)
+                                   `(,cmp for ,vector-binary-search))))
+                  (cond ((zero?     comparison) i)
+                        ((positive? comparison) (loop start i i))
+                        (else                   (loop i end i)))))))))))

 ;;; (VECTOR-ANY <pred?> <vector> ...) -> value
 ;;;   Apply PRED? to each parallel element in each VECTOR ...; if PRED?
@@ -1285,8 +1285,8 @@
             (let ((start (check-type nonneg-int? start list->vector))
                   (end   (check-type nonneg-int? end   list->vector)))
               ((lambda (f)
-                 (vector-unfold f (- end start) lst))
-               (lambda (l)
+                 (vector-unfold f (- end start) (list-tail lst start)))
+               (lambda (i l)
                  (cond ((null? l)
                         (error "List was too short"
                                `(list was ,lst)
@@ -1323,7 +1323,7 @@
     (let ((start (check-type nonneg-int? start reverse-list->vector))
           (end   (check-type nonneg-int? end   reverse-list->vector)))
       ((lambda (f)
-         (vector-unfold-right f (- end start) lst))
+         (vector-unfold-right f (- end start) (list-tail lst start)))
        (lambda (index l)
          (cond ((null? l)
                 (error "List too short"
;;;
;;; Tests for vector-lib
;;;
;;; Written by Shiro Kawai.  10/5/2005.  Public Domain.
;;;

;;; Notes:
;;;
;;;  - There are tests that expect the expression raise an error.
;;;    An implementation may extend srfi-34 to handle the cases which
;;;    srfi-34 states error.  You may want to omit assert-error's for
;;;    those cases.
;;;
;;;  - There are 3 procedures in the reference implementation that take
;;;    optional start and end arguments, although the srfi-34 document
;;;    does not specify them.  To test the extended versions, define
;;;    *extended-test* #t.
(define *extended-test* #t)

;;;
;;; Load the reference implementation
;;;

(load "vector-lib.scm")

;;;
;;; Test harness
;;; requires srfi-34 (guard)
;;;

(define *test-count* 0)
(define *failed-tests* '())

(define-syntax assert-equal
  (syntax-rules ()
    ((assert-equal comment expr expected)
     (let ((result expr))
       (set! *test-count* (+ *test-count* 1))
       (if (not (equal? result expected))
         (set! *failed-tests*
               (cons (list comment result expected) *failed-tests*)))))))

(define-syntax assert-error
  (syntax-rules ()
    ((assert-error comment expr)
     (guard (e (else #t))
       (set! *test-count* (+ *test-count* 1))
       (let ((result expr))
         (set! *failed-tests*
               (cons (list comment result 'error) *failed-tests*)))))))

(define (report-test-results)
  (let ((fail-count (length *failed-tests*)))
    (display *test-count*)
    (display " test(s), ")
    (display (- *test-count* fail-count))
    (display " passed, ")
    (display fail-count)
    (display " failed.")
    (newline)
    (if (positive? fail-count)
      (begin
        (display "Failures:") (newline)
        (for-each (lambda (f)
                    (display (car f))
                    (display " expects ")
                    (write (caddr f))
                    (display " but got ")
                    (write (cadr f))
                    (newline))
                  (reverse *failed-tests*))))
    ))

;;;
;;; Constructors
;;;

(assert-equal "make-vector 0"
              (vector-length (make-vector 5))
              5)
(assert-equal "make-vector 1"
              (make-vector 0)
              '#())
(assert-error "make-vector 2"
              (make-vector -4))

(assert-equal "make-vector 3"
              (make-vector 5 3)
              '#(3 3 3 3 3))
(assert-equal "make-vector 4"
              (make-vector 0 3)
              '#())
(assert-error "make-vector 5"
              (make-vector -1 3))

(assert-equal "vector 0"
              (vector)
              '#())
(assert-equal "vector 1"
              (vector 1 2 3 4 5)
              '#(1 2 3 4 5))

(assert-equal "vector-unfold 0"
              (vector-unfold (lambda (i x) (values x (- x 1)))
                             10 0)
              '#(0 -1 -2 -3 -4 -5 -6 -7 -8 -9))
(assert-equal "vector-unfold 1"
              (vector-unfold values 10)
              '#(0 1 2 3 4 5 6 7 8 9))
(assert-equal "vector-unfold 2"
              (vector-unfold values 0)
              '#())
(assert-error "vector-unfold 3"
              (vector-unfold values -1))

(assert-equal "vector-unfold-right 0"
              (vector-unfold-right (lambda (i x) (values x (+ x 1))) 10 0)
              '#(9 8 7 6 5 4 3 2 1 0))
(assert-equal "vector-unfold-right 1"
              (let ((vector '#(a b c d e)))
                (vector-unfold-right
                 (lambda (i x) (values (vector-ref vector x) (+ x 1)))
                 (vector-length vector)
                 0))
              '#(e d c b a))
(assert-equal "vector-unfold-right 2"
              (vector-unfold-right values 0)
              '#())
(assert-error "vector-unfold-right 3"
              (vector-unfold-right values -1))

(assert-equal "vector-copy 0"
              (vector-copy '#(a b c d e f g h i))
              '#(a b c d e f g h i))
(assert-equal "vector-copy 1"
              (vector-copy '#(a b c d e f g h i) 6)
              '#(g h i))
(assert-equal "vector-copy 2"
              (vector-copy '#(a b c d e f g h i) 3 6)
              '#(d e f))
(assert-equal "vector-copy 3"
              (vector-copy '#(a b c d e f g h i) 6 12 'x)
              '#(g h i x x x))
(assert-equal "vector-copy 4"
              (vector-copy '#(a b c d e f g h i) 6 6)
              '#())
(assert-error "vector-copy 5"
              (vector-copy '#(a b c d e f g h i) 4 2))

(assert-equal "vector-reverse-copy 0"
              (vector-reverse-copy '#(a b c d e))
              '#(e d c b a))
(assert-equal "vector-reverse-copy 1"
              (vector-reverse-copy '#(a b c d e) 1 4)
              '#(d c b))
(assert-equal "vector-reverse-copy 2"
              (vector-reverse-copy '#(a b c d e) 1 1)
              '#())
(assert-error "vector-reverse-copy 3"
              (vector-reverse-copy '#(a b c d e) 2 1))

(assert-equal "vector-append 0"
              (vector-append '#(x) '#(y))
              '#(x y))
(assert-equal "vector-append 1"
              (let ((v '#(x y)))
                (vector-append v v v))
              '#(x y x y x y))
(assert-equal "vector-append 2"
              (vector-append '#(x) '#() '#(y))
              '#(x y))
(assert-equal "vector-append 3"
              (vector-append)
              '#())
(assert-error "vector-append 4"
              (vector-append '#() 'b 'c))

(assert-equal "vector-concatenate 0"
              (vector-concatenate '(#(a b) #(c d)))
              '#(a b c d))
(assert-equal "vector-concatenate 1"
              (vector-concatenate '())
              '#())
(assert-error "vector-concatenate 2"
              (vector-concatenate '(#(a b) c)))

;;;
;;; Predicates
;;;

(assert-equal "vector? 0" (vector? '#()) #t)
(assert-equal "vector? 1" (vector? '#(a b)) #t)
(assert-equal "vector? 2" (vector? '(a b)) #f)
(assert-equal "vector? 3" (vector? 'a) #f)

(assert-equal "vector-empty? 0" (vector-empty? '#()) #t)
(assert-equal "vector-empty? 1" (vector-empty? '#(a)) #f)

(assert-equal "vector= 0"
              (vector= eq? '#(a b c d) '#(a b c d))
              #t)
(assert-equal "vector= 1"
              (vector= eq? '#(a b c d) '#(a b c d) '#(a b c d))
              #t)
(assert-equal "vector= 2"
              (vector= eq? '#() '#())
              #t)
(assert-equal "vector= 3"
              (vector= eq?)
              #t)
(assert-equal "vector= 4"
              (vector= eq? '#(a))
              #t)
(assert-equal "vector= 5"
              (vector= eq? '#(a b c d) '#(a b d c))
              #f)
(assert-equal "vector= 6"
              (vector= eq? '#(a b c d) '#(a b c d) '#(a b d c))
              #f)
(assert-equal "vector= 7"
              (vector= eq? '#(a b c) '#(a b d c))
              #f)
(assert-equal "vector= 8"
              (vector= eq? '#() '#(a b d c))
              #f)
(assert-equal "vector= 9"
              (vector= eq? '#(a b d c) '#())
              #f)
(assert-equal "vector= 10"
              (vector= equal? '#("a" "b" "c") '#("a" "b" "c"))
              #t)
(assert-error "vector= 11"
              (vector= equal? '#("a" "b" "c") '("a" "b" "c")))

;;;
;;; Selectors
;;;

(assert-equal "vector-ref 0" (vector-ref '#(a b c) 0) 'a)
(assert-equal "vector-ref 1" (vector-ref '#(a b c) 1) 'b)
(assert-equal "vector-ref 2" (vector-ref '#(a b c) 2) 'c)
(assert-error "vector-ref 3" (vector-ref '#(a b c) -1))
(assert-error "vector-ref 4" (vector-ref '#(a b c) 3))
(assert-error "vector-ref 5" (vector-ref '#() 0))

(assert-equal "vector-length 0" (vector-length '#()) 0)
(assert-equal "vector-length 1" (vector-length '#(a b c)) 3)
(assert-error "vector-length 2" (vector-length '(a b c)))

;;;
;;; Iteration
;;;

(assert-equal "vector-fold 0"
              (vector-fold (lambda (i seed val) (+ seed val))
                           0
                           '#(0 1 2 3 4))
              10)
(assert-equal "vector-fold 1"
              (vector-fold (lambda (i seed val) (+ seed val))
                           'a
                           '#())
              'a)
(assert-equal "vector-fold 2"
              (vector-fold (lambda (i seed val) (+ seed (* i val)))
                           0
                           '#(0 1 2 3 4))
              30)
(assert-equal "vector-fold 3"
              (vector-fold (lambda (i seed x y) (cons (- x y) seed))
                           '()
                           '#(6 1 2 3 4) '#(7 0 9 2))
              '(1 -7 1 -1))

(assert-equal "vector-fold-right 0"
              (vector-fold-right (lambda (i seed val) (cons (cons i val) seed))
                                 '()
                                 '#(a b c d e))
              '((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)))
(assert-equal "vector-fold-right 1"
              (vector-fold-right (lambda (i seed x y) (cons (- x y) seed))
                                 '()
                                 '#(6 1 2 3 7) '#(7 0 9 2))
              '(-1 1 -7 1))

(assert-equal "vector-map 0"
              (vector-map cons '#(a b c d e))
              '#((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)))
(assert-equal "vector-map 1"
              (vector-map cons '#())
              '#())
(assert-equal "vector-map 2"
              (vector-map + '#(0 1 2 3 4) '#(5 6 7 8))
              '#(5 8 11 14))

(assert-equal "vector-map! 0"
              (let ((v (vector 0 1 2 3 4)))
                (vector-map! * v)
                v)
              '#(0 1 4 9 16))
(assert-equal "vector-map! 1"
              (let ((v (vector)))
                (vector-map! * v)
                v)
              '#())
(assert-equal "vector-map! 2"
              (let ((v (vector 0 1 2 3 4)))
                (vector-map! + v '#(5 6 7 8))
                v)
              '#(5 8 11 14 4))

(assert-equal "vector-for-each 0"
              (let ((sum 0))
                (vector-for-each (lambda (i x)
                                   (set! sum (+ sum (* i x))))
                                 '#(0 1 2 3 4))
                sum)
              30)
(assert-equal "vector-for-each 1"
              (let ((sum 0))
                (vector-for-each (lambda (i x)
                                   (set! sum (+ sum (* i x))))
                                 '#())
                sum)
              0)

(assert-equal "vector-count 0"
              (vector-count (lambda (i x) (even? x)) '#(0 1 2 3 4 5 6))
              4)
(assert-equal "vector-count 1"
              (vector-count values '#())
              0)
(assert-equal "vector-count 2"
              (vector-count (lambda (i x y) (< x y))
                            '#(8 2 7 4 9 1 0)
                            '#(7 6 8 3 1 1 9))
              3)

;;;
;;; Searching
;;;

(assert-equal "vector-index 0"
              (vector-index even? '#(3 1 4 1 5 9))
              2)
(assert-equal "vector-index 1"
              (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
              1)
(assert-equal "vector-index 2"
              (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
              #f)
(assert-equal "vector-index 3"
              (vector-index < '#() '#(2 7 1 8 2))
              #f)

(assert-equal "vector-index-right 0"
              (vector-index-right even? '#(3 1 4 1 5 9 2))
              6)
(assert-equal "vector-index-right 1"
              (vector-index-right < '#(3 1 4 1 5) '#(2 7 1 8 2))
              3)
(assert-equal "vector-index-right 2"
              (vector-index-right = '#(3 1 4 1 5) '#(2 7 1 8 2))
              #f)
(assert-equal "vector-index-right 3"
              (vector-index-right even? #())
              #f)

(assert-equal "vector-skip 0"
              (vector-skip odd? '#(3 1 4 1 5 9))
              2)
(assert-equal "vector-skip 1"
              (vector-skip < '#(3 1 4 1 5 9 2 5 6) '#(4 9 5 0 2 4))
              3)
(assert-equal "vector-skip 2"
              (vector-skip < '#(3 1 4 1 5 2 5 6) '#(4 9 5 9 9 9))
              #f)
(assert-equal "vector-skip 3"
              (vector-skip < '#() '#(4 9 5 9 9 9))
              #f)

(assert-equal "vector-skip-right 0"
              (vector-skip-right odd? '#(3 1 4 1 5 9 2 6 5 3))
              7)
(assert-equal "vector-skip-right 1"
              (vector-skip-right < '#(8 3 7 3 1 0) '#(4 9 5 0 2 4))
              3)
(assert-equal "vector-skip-right 2"
              (vector-skip-right < '#() '#(4 9 5 0 2 4))
              #f)

(define (char-cmp c1 c2)
  (cond ((char<? c1 c2) -1)
        ((char=? c1 c2) 0)
        (else 1)))

(assert-equal "vector-binary-search 0"
              (vector-binary-search
               '#(#\a #\b #\c #\d #\e #\f #\g #\h)
               #\g
               char-cmp)
              6)
(assert-equal "vector-binary-search 1"
              (vector-binary-search
               '#(#\a #\b #\c #\d #\e #\f #\g)
               #\q
               char-cmp)
              #f)
(assert-equal "vector-binary-search 2"
              (vector-binary-search
               '#(#\a)
               #\a
               char-cmp)
              0)
(assert-equal "vector-binary-search 3"
              (vector-binary-search
               '#()
               #\a
               char-cmp)
              #f)
(assert-error "vector-binary-search 4"
              (vector-binary-search
               '(#\a #\b #\c)
               #\a
               char-cmp))

(cond
 (*extended-test*
  (assert-equal "vector-binary-search 5"
                (vector-binary-search
                 '#(#\a #\b #\c #\d #\e #\f #\g #\h)
                 #\d
                 char-cmp
                 2 6)
                3)
  (assert-equal "vector-binary-search 6"
                (vector-binary-search
                 '#(#\a #\b #\c #\d #\e #\f #\g #\h)
                 #\g
                 char-cmp
                 2 6)
                #f)
  ))

(assert-equal "vector-any 0"
              (vector-any even? '#(3 1 4 1 5 9 2))
              #t)
(assert-equal "vector-any 1"
              (vector-any even? '#(3 1 5 1 5 9 1))
              #f)
(assert-equal "vector-any 2"
              (vector-any even? '#(3 1 4 1 5 #f 2))
              #t)
(assert-equal "vector-any 3"
              (vector-any even? '#())
              #f)
(assert-equal "vector-any 4"
              (vector-any < '#(3 1 4 1 5 #f) '#(1 0 1 2 3))
              #t)
(assert-equal "vector-any 5"
              (vector-any < '#(3 1 4 1 5 #f) '#(1 0 1 0 3))
              #f)

(assert-equal "vector-every 0"
              (vector-every odd? '#(3 1 4 1 5 9 2))
              #f)
(assert-equal "vector-every 1"
              (vector-every odd? '#(3 1 5 1 5 9 1))
              #t)
(assert-equal "vector-every 2"
              (vector-every odd? '#(3 1 4 1 5 #f 2))
              #f)
(assert-equal "vector-every 3"
              (vector-every even? '#())
              #t)
(assert-equal "vector-every 4"
              (vector-every >= '#(3 1 4 1 5) '#(1 0 1 2 3 #f))
              #f)
(assert-equal "vector-every 5"
              (vector-every >= '#(3 1 4 1 5) '#(1 0 1 0 3 #f))
              #t)

;;;
;;; Mutators
;;;

(assert-equal "vector-set! 0"
              (let ((v (vector 0 1 2)))
                (vector-set! v 1 'a)
                v)
              '#(0 a 2))
(assert-error "vector-set! 1" (vector-set! (vector 0 1 2) 3 'a))
(assert-error "vector-set! 2" (vector-set! (vector 0 1 2) -1 'a))
(assert-error "vector-set! 3" (vector-set! (vector) 0 'a))

(assert-equal "vector-swap! 0"
              (let ((v (vector 'a 'b 'c)))
                (vector-swap! v 0 1)
                v)
              '#(b a c))
(assert-equal "vector-swap! 1"
              (let ((v (vector 'a 'b 'c)))
                (vector-swap! v 1 1)
                v)
              '#(a b c))
(assert-error "vector-swap! e0" (vector-swap! (vector 'a 'b 'c) 0 3))
(assert-error "vector-swap! e1" (vector-swap! (vector 'a 'b 'c) -1 1))
(assert-error "vector-swap! e2" (vector-swap! (vector) 0 0))

(assert-equal "vector-fill! 0"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-fill! v 'z)
                v)
              '#(z z z z z))
(assert-equal "vector-fill! 1"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-fill! v 'z 2)
                v)
              '#(a b z z z))
(assert-equal "vector-fill! 2"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-fill! v 'z 1 3)
                v)
              '#(a z z d e))
(assert-equal "vector-fill! 3"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-fill! v 'z 0 5)
                v)
              '#(z z z z z))
(assert-equal "vector-fill! 4"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-fill! v 'z 2 2)
                v)
              '#(a b c d e))
(assert-error "vector-fill! e0" (vector-fill! (vector 'a 'b 'c) 'z 0 4))
(assert-error "vector-fill! e1" (vector-fill! (vector 'a 'b 'c) 'z 2 1))
(assert-error "vector-fill! e2" (vector-fill! (vector 'a 'b 'c) 'z -1 1))
(assert-error "vector-fill! e3" (vector-fill! (vector) 'z 0 0))

(assert-equal "vector-reverse! 0"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse! v)
                v)
              '#(e d c b a))
(assert-equal "vector-reverse! 1"
              (let ((v (vector 'a 'b 'c 'd 'e 'f)))
                (vector-reverse! v 1 4)
                v)
              '#(a d c b e f))
(assert-equal "vector-reverse! 2"
              (let ((v (vector 'a 'b 'c 'd 'e 'f)))
                (vector-reverse! v 3 3)
                v)
              '#(a b c d e f))
(assert-equal "vector-reverse! 3"
              (let ((v (vector 'a 'b 'c 'd 'e 'f)))
                (vector-reverse! v 3 4)
                v)
              '#(a b c d e f))
(assert-equal "vector-reverse! 4"
              (let ((v (vector)))
                (vector-reverse! v)
                v)
              '#())
(assert-error "vector-reverse! e0" (vector-reverse! (vector 'a 'b) 0 3))
(assert-error "vector-reverse! e1" (vector-reverse! (vector 'a 'b) 2 1))
(assert-error "vector-reverse! e2" (vector-reverse! (vector 'a 'b) -1 1))
(assert-error "vector-reverse! e3" (vector-reverse! (vector) 0 0))

(assert-equal "vector-copy! 0"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 0 '#(1 2 3))
                v)
              '#(1 2 3 d e))
(assert-equal "vector-copy! 1"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 2 '#(1 2 3))
                v)
              '#(a b 1 2 3))
(assert-equal "vector-copy! 2"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 2 '#(1 2 3) 1)
                v)
              '#(a b 2 3 e))
(assert-equal "vector-copy! 3"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 2 '#(1 2 3 4 5) 2 5)
                v)
              '#(a b 3 4 5))
(assert-equal "vector-copy! 4"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 2 '#(1 2 3) 1 1)
                v)
              '#(a b c d e))
(assert-equal "vector-copy! self0"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 0 v 1 3)
                v)
              '#(b c c d e))
(assert-equal "vector-copy! self1"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 2 v 1 4)
                v)
              '#(a b b c d))
(assert-equal "vector-copy! self2"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-copy! v 0 v 0)
                v)
              '#(a b c d e))
(assert-error "vector-copy! e0" (vector-copy! (vector 1 2) 3 '#(1 2 3)))
(assert-error "vector-copy! e1" (vector-copy! (vector 1 2) 0 '#(1 2 3)))
(assert-error "vector-copy! e2" (vector-copy! (vector 1 2) 1 '#(1 2 3) 1))

(assert-equal "vector-reverse-copy! 0"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse-copy! v 0 '#(1 2 3))
                v)
              '#(3 2 1 d e))
(assert-equal "vector-reverse-copy! 1"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse-copy! v 2 '#(1 2 3))
                v)
              '#(a b 3 2 1))
(assert-equal "vector-reverse-copy! 2"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse-copy! v 2 '#(1 2 3) 1)
                v)
              '#(a b 3 2 e))
(assert-equal "vector-reverse-copy! 3"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse-copy! v 2 '#(1 2 3 4 5) 1 4)
                v)
              '#(a b 4 3 2))
(assert-equal "vector-reverse-copy! 4"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse-copy! v 2 '#(1 2 3 4 5) 2 2)
                v)
              '#(a b c d e))
(assert-equal "vector-reverse-copy! self0"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse-copy! v 0 v)
                v)
              '#(e d c b a))
(assert-equal "vector-reverse-copy! self1"
              (let ((v (vector 'a 'b 'c 'd 'e)))
                (vector-reverse-copy! v 0 v 0 2)
                v)
              '#(b a c d e))
(assert-error "vector-reverse-copy! e0"
              (vector-reverse-copy! (vector 'a 'b) 2 '#(a b)))
(assert-error "vector-reverse-copy! e1"
              (vector-reverse-copy! (vector 'a 'b) -1 '#(a b)))
(assert-error "vector-reverse-copy! e2"
              (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c)))
(assert-error "vector-reverse-copy! e3"
              (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 1 4))
(assert-error "vector-reverse-copy! e4"
              (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) -1 2))
(assert-error "vector-reverse-copy! e5"
              (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 2 1))

;;;
;;; Conversion
;;;

(assert-equal "vector->list 0"
              (vector->list '#(a b c))
              '(a b c))
(assert-equal "vector->list 1"
              (vector->list '#(a b c) 1)
              '(b c))
(assert-equal "vector->list 2"
              (vector->list '#(a b c d e) 1 4)
              '(b c d))
(assert-equal "vector->list 3"
              (vector->list '#(a b c d e) 1 1)
              '())
(assert-equal "vector->list 4"
              (vector->list '#())
              '())
(assert-error "vector->list e0" (vector->list '#(a b c) 1 6))
(assert-error "vector->list e1" (vector->list '#(a b c) -1 1))
(assert-error "vector->list e2" (vector->list '#(a b c) 2 1))

(assert-equal "reverse-vector->list 0"
              (reverse-vector->list '#(a b c))
              '(c b a))
(assert-equal "reverse-vector->list 1"
              (reverse-vector->list '#(a b c) 1)
              '(c b))
(assert-equal "reverse-vector->list 2"
              (reverse-vector->list '#(a b c d e) 1 4)
              '(d c b))
(assert-equal "reverse-vector->list 3"
              (reverse-vector->list '#(a b c d e) 1 1)
              '())
(assert-equal "reverse-vector->list 4"
              (reverse-vector->list '#())
              '())
(assert-error "reverse-vector->list e0" (reverse-vector->list '#(a b c) 1 6))
(assert-error "reverse-vector->list e1" (reverse-vector->list '#(a b c) -1 1))
(assert-error "reverse-vector->list e2" (reverse-vector->list '#(a b c) 2 1))

(assert-equal "list->vector 0"
              (list->vector '(a b c))
              '#(a b c))
(assert-equal "list->vector 1"
              (list->vector '())
              '#())
(cond
 (*extended-test*
  (assert-equal "list->vector 2"
                (list->vector '(0 1 2 3) 2)
                '#(2 3))
  (assert-equal "list->vector 3"
                (list->vector '(0 1 2 3) 0 2)
                '#(0 1))
  (assert-equal "list->vector 4"
                (list->vector '(0 1 2 3) 2 2)
                '#())
  (assert-error "list->vector e0" (list->vector '(0 1 2 3) 0 5))
  (assert-error "list->vector e1" (list->vector '(0 1 2 3) -1 1))
  (assert-error "list->vector e2" (list->vector '(0 1 2 3) 2 1))
  ))

(assert-equal "reverse-list->vector 0"
              (reverse-list->vector '(a b c))
              '#(c b a))
(assert-equal "reverse-list->vector 1"
              (reverse-list->vector '())
              '#())
(cond
 (*extended-test*
  (assert-equal "reverse-list->vector 2"
                (reverse-list->vector '(0 1 2 3) 2)
                '#(3 2))
  (assert-equal "reverse-list->vector 3"
                (reverse-list->vector '(0 1 2 3) 0 2)
                '#(1 0))
  (assert-equal "reverse-list->vector 4"
                (reverse-list->vector '(0 1 2 3) 2 2)
                '#())
  (assert-error "reverse-list->vector e0"
                (reverse-list->vector '(0 1 2 3) 0 5))
  (assert-error "reverse-list->vector e1"
                (reverse-list->vector '(0 1 2 3) -1 1))
  (assert-error "reverse-list->vector e2"
                (reverse-list->vector '(0 1 2 3) 2 1))
  ))

(report-test-results)