mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 21:59:17 +02:00
197 lines
8.8 KiB
Scheme
197 lines
8.8 KiB
Scheme
(define-library (srfi 160 test)
|
|
(import (scheme base)
|
|
(srfi 160 base) (srfi 160 u32) (srfi 160 u64) (srfi 160 s64)
|
|
(chibi test))
|
|
(export run-tests)
|
|
(begin
|
|
(define (run-tests)
|
|
(test-begin "srfi-160: uniform vectors")
|
|
(test-group "uvectors/constructors"
|
|
(define a2i '#u32(0 1 2 3 4 5 6 7 8))
|
|
(test '#u8(0 1 2 3 4) (u8vector 0 1 2 3 4))
|
|
(test '#u32(0 1 2 3 4) (u32vector 0 1 2 3 4))
|
|
(test '#u32(0 1 2 3 4 5 6 7 8 9)
|
|
(u32vector-unfold (lambda (i x) (values x (+ x 1))) 10 0))
|
|
(test '#u32(0 1 2 3 4 5 6) (u32vector-unfold values 7 #f))
|
|
(test a2i (u32vector-copy a2i))
|
|
(test-assert (not (eqv? a2i (u32vector-copy a2i))))
|
|
(test '#u32(6 7 8) (u32vector-copy a2i 6))
|
|
(test '#u32(3 4 5) (u32vector-copy a2i 3 6))
|
|
(test '#u32(4 3 1) (u32vector-reverse-copy (u32vector 1 3 4)))
|
|
(test '#u32(1 2 3 4) (u32vector-reverse-copy '#u32(5 4 3 2 1 0) 1 5))
|
|
(test '(#u32(#x01 #x02) #u32(#x03 #x04))
|
|
(u32vector-segment #u32(1 2 3 4) 2))
|
|
(test '#u32(0 1) (u32vector-append '#u32(0) '#u32(1)))
|
|
(test '#u32(0 1 2 3) (u32vector-append '#u32(0) '#u32(1 2 3)))
|
|
(test '#u64(0 1 2 3) (u64vector-append '#u64(0) '#u64(1 2 3)))
|
|
(test '#s64(0 -1 2 -3) (s64vector-append '#s64(0) '#s64(-1 2 -3)))
|
|
(test '#u32(0 1 2 3) (u32vector-concatenate '(#u32(0 1) #u32(2 3))))
|
|
(test '#u32(0 1 6 7)
|
|
(u32vector-append-subvectors '#u32(0 1 2 3 4) 0 2 '#u32(4 5 6 7 8) 2 4))
|
|
(test '#u32(1 2)
|
|
(vector->u32vector '#(0 1 2 3) 1 3))
|
|
(test '#(1 2)
|
|
(u32vector->vector '#u32(0 1 2 3) 1 3))
|
|
)
|
|
|
|
(test-group "uvectors/predicates"
|
|
(test #f (u32vector-empty? '#u32(0)))
|
|
(test-assert (u32vector-empty? '#u32()))
|
|
(test-assert (u32vector= '#u32(0 1 2 3) '#u32(0 1 2 3)))
|
|
(test #t (u32vector= '#u32(0 1 2 3) '#u32(0 1 2 3)))
|
|
(test #f (u32vector= '#u32(1 2 3 4 5) '#u32(1 2 3 4)))
|
|
(test-assert (u32vector=))
|
|
(test-assert (u32vector= '#u32(0)))
|
|
(test-assert (u32vector= (u32vector 0) (u32vector 0)))
|
|
)
|
|
|
|
(test-group "uvectors/iteration"
|
|
(define vec '#u32(0 1 2 3 4 5))
|
|
(define vec2 (u32vector 0 1 2 3 4))
|
|
(define vec3 (u32vector 1 2 3 4 5))
|
|
(test '(5 4 3 2 1 0)
|
|
(u32vector-fold (lambda (tail elt) (cons elt tail)) '() vec))
|
|
(test 3 (u32vector-fold (lambda (ctr n) (if (even? n) (+ ctr 1) ctr)) 0 vec))
|
|
(test '(0 1 2 3) (u32vector-fold-right (lambda (tail elt) (cons elt tail))
|
|
'() '#u32(0 1 2 3)))
|
|
(test '#u32(1 4 9 16) (u32vector-map square '#u32(1 2 3 4)))
|
|
(test '#u32(5 8 9 8 5) (u32vector-map * '#u32(1 2 3 4 5) '#u32(5 4 3 2 1)))
|
|
(u32vector-map! square vec2)
|
|
(test '#u32(0 1 4 9 16) (u32vector-copy vec2))
|
|
(u32vector-map! * vec2 vec3)
|
|
(test '#u32(0 2 12 36 80) (u32vector-copy vec2))
|
|
(let ((result '()))
|
|
(u32vector-for-each (lambda (x) (set! result (cons x result))) vec)
|
|
(test '(5 4 3 2 1 0) result))
|
|
(test 3 (u32vector-count even? '#u32(3 1 4 1 5 9 2 5 6)))
|
|
(test 2 (u32vector-count < '#u32(1 3 6 9) '#u32(2 4 6 8 10 12)))
|
|
(test '#u32(3 4 8 9 14 23 25 30 36) (u32vector-cumulate + 0 '#u32(3 1 4 1 5 9 2 5 6)))
|
|
)
|
|
|
|
(test-group "uvectors/searching"
|
|
(define (cmp a b)
|
|
(cond
|
|
((< a b) -1)
|
|
((= a b) 0)
|
|
(else 1)))
|
|
(define v '#u32(0 2 4 6 8 10 12))
|
|
(test 2 (u32vector-index even? '#u32(3 1 4 1 5 9 6)))
|
|
(test 5 (u32vector-index-right odd? '#u32(3 1 4 1 5 9 6)))
|
|
(test 2 (u32vector-skip odd? '#u32(1 3 2 5 7 1 1 8 9)))
|
|
(test 7 (u32vector-skip-right odd? '#u32(1 3 2 5 7 1 1 8 9)))
|
|
(test 0 (u32vector-binary-search v 0 cmp))
|
|
(test 3 (u32vector-binary-search v 6 cmp))
|
|
(test #f (u32vector-binary-search v 1 cmp))
|
|
(test-assert (u32vector-any even? '#u32(1 2 3 4 5)))
|
|
(test-assert (u32vector-any < '#u32(1 2 3 4 5) '#u32(2 1 3 4 5)))
|
|
(test #f (u32vector-any odd? '#u32(2 4 6 8)))
|
|
(test #f (u32vector-any > '#u32(1 2 3 4 5) '#u32(1 2 3 4 5)))
|
|
(test #f (u32vector-every odd? '#u32(1 2 3 4 5)))
|
|
(test-assert (u32vector-every number? '#u32(1 2 3 4 5)))
|
|
(test #f (u32vector-every < '#u32(1 2 3) '#u32(2 3 3)))
|
|
(test-assert (u32vector-every < '#u32(1 2 3) '#u32(2 3 4)))
|
|
(test 'yes (u32vector-any (lambda (x) (if (even? x) 'yes #f)) '#u32(1 3 2 5 7)))
|
|
(let-values (((new off) (u32vector-partition odd? '#u32(1 2 3 4 5 6))))
|
|
(test '#u32(1 3 5 2 4 6) (u32vector-copy new))
|
|
(test 3 off))
|
|
)
|
|
|
|
(test-group "uvectors/mutation"
|
|
(define vs (u32vector 1 2 3))
|
|
(define vf0 (u32vector 1 2 3))
|
|
(define vf1 (u32vector 1 2 3))
|
|
(define vf2 (u32vector 1 2 3))
|
|
(define vr0 (u32vector 1 2 3))
|
|
(define vr1 (u32vector 1 2 3))
|
|
(define vr2 (u32vector 1 2 3))
|
|
(define vc0 (u32vector 1 2 3 4 5))
|
|
(define vc1 (u32vector 1 2 3 4 5))
|
|
(define vc2 (u32vector 1 2 3 4 5))
|
|
(define vrc0 (u32vector 1 2 3 4 5))
|
|
(define vrc1 (u32vector 1 2 3 4 5))
|
|
(define vrc2 (u32vector 1 2 3 4 5))
|
|
(define vu0 (u32vector 1 2 3 4 5))
|
|
(define vu1 (u32vector 1 2 3 4 5))
|
|
(define vu2 (u32vector 1 2 3 4 5))
|
|
(define vur0 (u32vector 1 2 3 4 5))
|
|
(define vur1 (u32vector 1 2 3 4 5))
|
|
(define vur2 (u32vector 1 2 3 4 5))
|
|
(u32vector-swap! vs 0 1)
|
|
(test '#u32(2 1 3) (u32vector-copy vs))
|
|
(u32vector-fill! vf0 0)
|
|
(test '#u32(0 0 0) (u32vector-copy vf0))
|
|
(u32vector-fill! vf1 0 1)
|
|
(test '#u32(1 0 0) (u32vector-copy vf1))
|
|
(u32vector-fill! vf2 0 0 1)
|
|
(test '#u32(0 2 3) (u32vector-copy vf2))
|
|
(u32vector-reverse! vr0)
|
|
(test '#u32(3 2 1) (u32vector-copy vr0))
|
|
(u32vector-reverse! vr1 1)
|
|
(test '#u32(1 3 2) (u32vector-copy vr1))
|
|
(u32vector-reverse! vr2 0 2)
|
|
(test '#u32(2 1 3) (u32vector-copy vr2))
|
|
(u32vector-copy! vc0 1 '#u32(10 20 30))
|
|
(test '#u32(1 10 20 30 5) (u32vector-copy vc0))
|
|
(u32vector-copy! vc1 1 '#u32(0 10 20 30 40) 1)
|
|
(test '#u32(1 10 20 30 40) (u32vector-copy vc1))
|
|
(u32vector-copy! vc2 1 '#u32(0 10 20 30 40) 1 4)
|
|
(test '#u32(1 10 20 30 5) (u32vector-copy vc2))
|
|
(u32vector-reverse-copy! vrc0 1 '#u32(10 20 30))
|
|
(test '#u32(1 30 20 10 5) (u32vector-copy vrc0))
|
|
(u32vector-reverse-copy! vrc1 1 '#u32(0 10 20 30 40) 1)
|
|
(test '#u32(1 40 30 20 10) (u32vector-copy vrc1))
|
|
(u32vector-reverse-copy! vrc2 1 '#u32(0 10 20 30 40) 1 4)
|
|
(test '#u32(1 30 20 10 5) (u32vector-copy vrc2))
|
|
(let ((uv (make-u64vector 2 0)))
|
|
(u64vector-set! uv 0 10631884467263188874)
|
|
(test '#u64(10631884467263188874 0) uv))
|
|
)
|
|
|
|
(test-group "uvectors/conversion"
|
|
(test '(1 2 3) (u32vector->list '#u32(1 2 3)))
|
|
(test '(2 3) (u32vector->list '#u32(1 2 3) 1))
|
|
(test '(1 2) (u32vector->list '#u32(1 2 3) 0 2))
|
|
(test '#u32(1 2 3) (list->u32vector '(1 2 3)))
|
|
(test '(3 2 1) (reverse-u32vector->list '#u32(1 2 3)))
|
|
(test '(3 2) (reverse-u32vector->list '#u32(1 2 3) 1))
|
|
(test '(2 1) (reverse-u32vector->list '#u32(1 2 3) 0 2))
|
|
(test '#u32(3 2 1) (reverse-list->u32vector '(1 2 3)))
|
|
)
|
|
|
|
(test-group "bitvectors"
|
|
(let ((uv #u1(0 1 0 1 0 1 0)))
|
|
(test 0 (u1vector-ref uv 0))
|
|
(test 1 (u1vector-ref uv 1))
|
|
(test 0 (u1vector-ref uv 2))
|
|
(test 1 (u1vector-ref uv 3))
|
|
(test 0 (u1vector-ref uv 4))
|
|
(test 1 (u1vector-ref uv 5))
|
|
(test 0 (u1vector-ref uv 6))
|
|
(test-error (u1vector-ref uv -1))
|
|
(test-error (u1vector-ref uv 7)))
|
|
(let ((uv #u1(1 0 1 0 1 0 1 0)))
|
|
(test 1 (u1vector-ref uv 0))
|
|
(test 0 (u1vector-ref uv 1))
|
|
(test 1 (u1vector-ref uv 2))
|
|
(test 0 (u1vector-ref uv 3))
|
|
(test 1 (u1vector-ref uv 4))
|
|
(test 0 (u1vector-ref uv 5))
|
|
(test 1 (u1vector-ref uv 6))
|
|
(test 0 (u1vector-ref uv 7))
|
|
(test-error (u1vector-ref uv -1))
|
|
(test-error (u1vector-ref uv 8)))
|
|
(let ((uv #u1(0 1 0 1 0 1 0 1 0)))
|
|
(test 0 (u1vector-ref uv 0))
|
|
(test 1 (u1vector-ref uv 1))
|
|
(test 0 (u1vector-ref uv 2))
|
|
(test 1 (u1vector-ref uv 3))
|
|
(test 0 (u1vector-ref uv 4))
|
|
(test 1 (u1vector-ref uv 5))
|
|
(test 0 (u1vector-ref uv 6))
|
|
(test 1 (u1vector-ref uv 7))
|
|
(test 0 (u1vector-ref uv 8))
|
|
(test-error (u1vector-ref uv -1))
|
|
(test-error (u1vector-ref uv 9)))
|
|
)
|
|
|
|
(test-end))))
|