mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 21:59:17 +02:00
338 lines
15 KiB
Scheme
338 lines
15 KiB
Scheme
|
|
(define-library (srfi 116 test)
|
|
(import (scheme base) (srfi 116) (chibi test))
|
|
(export run-tests)
|
|
(begin
|
|
(define (run-tests)
|
|
(test-group "srfi-116: ilists"
|
|
|
|
(test-group "ilists/constructors"
|
|
(define abc (ilist 'a 'b 'c))
|
|
(define abc-dot-d (ipair* 'a 'b 'c 'd))
|
|
(define abc-copy (ilist-copy abc))
|
|
(test 'a (icar abc))
|
|
(test 'b (icadr abc))
|
|
(test 'c (icaddr abc))
|
|
(test (ipair 2 1) (xipair 1 2))
|
|
(test 'd (icdddr abc-dot-d))
|
|
(test (iq c c c c) (make-ilist 4 'c))
|
|
(test (iq 0 1 2 3) (ilist-tabulate 4 values))
|
|
(test (iq 0 1 2 3 4) (iiota 5))
|
|
(test abc abc-copy)
|
|
(test-assert (not (eq? abc abc-copy))))
|
|
|
|
(test-group "ilists/predicates"
|
|
(test-assert (ipair? (ipair 1 2)))
|
|
(test-assert (proper-ilist? '()))
|
|
(test-assert (proper-ilist? (iq 1 2 3)))
|
|
(test-assert (ilist? '()))
|
|
(test-assert (ilist? (iq 1 2 3)))
|
|
(test-assert (dotted-ilist? (ipair 1 2)))
|
|
(test-assert (dotted-ilist? 2))
|
|
(test-assert (null-ilist? '()))
|
|
(test-assert (not (null-ilist? (iq 1 2 3))))
|
|
;;(test-error (null-ilist? 'a))
|
|
(test-assert (not-ipair? 'a))
|
|
(test-assert (not (not-ipair? (ipair 'a 'b))))
|
|
(test-assert (ilist= = (iq 1 2 3) (iq 1 2 3)))
|
|
(test-assert (ilist= = (iq 1 2 3) (iq 1 2 3) (iq 1 2 3)))
|
|
(test-assert (not (ilist= = (iq 1 2 3 4) (iq 1 2 3))))
|
|
(test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3 4))))
|
|
(test-assert (ilist= = (iq 1 2 3) (iq 1 2 3)))
|
|
(test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3 4) (iq 1 2 3 4))))
|
|
(test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3) (iq 1 2 3 4)))))
|
|
|
|
(test-group "ilist/cxrs"
|
|
(define ab (ipair 'a 'b))
|
|
(define cd (ipair 'c 'd))
|
|
(define ef (ipair 'e 'f))
|
|
(define gh (ipair 'g 'h))
|
|
(define abcd (ipair ab cd))
|
|
(define efgh (ipair ef gh))
|
|
(define abcdefgh (ipair abcd efgh))
|
|
(define ij (ipair 'i 'j))
|
|
(define kl (ipair 'k 'l))
|
|
(define mn (ipair 'm 'n))
|
|
(define op (ipair 'o 'p))
|
|
(define ijkl (ipair ij kl))
|
|
(define mnop (ipair mn op))
|
|
(define ijklmnop (ipair ijkl mnop))
|
|
(define abcdefghijklmnop (ipair abcdefgh ijklmnop))
|
|
(test 'a (icaar abcd))
|
|
(test 'b (icdar abcd))
|
|
(test 'c (icadr abcd))
|
|
(test 'd (icddr abcd))
|
|
(test 'a (icaaar abcdefgh))
|
|
(test 'b (icdaar abcdefgh))
|
|
(test 'c (icadar abcdefgh))
|
|
(test 'd (icddar abcdefgh))
|
|
(test 'e (icaadr abcdefgh))
|
|
(test 'f (icdadr abcdefgh))
|
|
(test 'g (icaddr abcdefgh))
|
|
(test 'h (icdddr abcdefgh))
|
|
(test 'a (icaaaar abcdefghijklmnop))
|
|
(test 'b (icdaaar abcdefghijklmnop))
|
|
(test 'c (icadaar abcdefghijklmnop))
|
|
(test 'd (icddaar abcdefghijklmnop))
|
|
(test 'e (icaadar abcdefghijklmnop))
|
|
(test 'f (icdadar abcdefghijklmnop))
|
|
(test 'g (icaddar abcdefghijklmnop))
|
|
(test 'h (icdddar abcdefghijklmnop))
|
|
(test 'i (icaaadr abcdefghijklmnop))
|
|
(test 'j (icdaadr abcdefghijklmnop))
|
|
(test 'k (icadadr abcdefghijklmnop))
|
|
(test 'l (icddadr abcdefghijklmnop))
|
|
(test 'm (icaaddr abcdefghijklmnop))
|
|
(test 'n (icdaddr abcdefghijklmnop))
|
|
(test 'o (icadddr abcdefghijklmnop))
|
|
(test 'p (icddddr abcdefghijklmnop)))
|
|
|
|
(test-group "ilists/selectors"
|
|
(define ten (ilist 1 2 3 4 5 6 7 8 9 10))
|
|
(define abcde (iq a b c d e))
|
|
(define dotted (ipair 1 (ipair 2 (ipair 3 'd))))
|
|
(test 'c (ilist-ref (iq a b c d) 2))
|
|
(test 1 (ifirst ten))
|
|
(test 2 (isecond ten))
|
|
(test 3 (ithird ten))
|
|
(test 4 (ifourth ten))
|
|
(test 5 (ififth ten))
|
|
(test 6 (isixth ten))
|
|
(test 7 (iseventh ten))
|
|
(test 8 (ieighth ten))
|
|
(test 9 (ininth ten))
|
|
(test 10 (itenth ten))
|
|
(test-error (ilist-ref '() 2))
|
|
(test '(1 2) (call-with-values (lambda () (icar+icdr (ipair 1 2))) list))
|
|
(test (iq a b) (itake abcde 2))
|
|
(test (iq c d e) (idrop abcde 2))
|
|
(test (iq c d e) (ilist-tail abcde 2))
|
|
(test (iq 1 2) (itake dotted 2))
|
|
(test (ipair 3 'd) (idrop dotted 2))
|
|
(test (ipair 3 'd) (ilist-tail dotted 2))
|
|
(test 'd (idrop dotted 3))
|
|
(test 'd (ilist-tail dotted 3))
|
|
(test abcde (iappend (itake abcde 4) (idrop abcde 4)))
|
|
(test (iq d e) (itake-right abcde 2))
|
|
(test (iq a b c) (idrop-right abcde 2))
|
|
(test (ipair 2 (ipair 3 'd)) (itake-right dotted 2))
|
|
(test (iq 1) (idrop-right dotted 2))
|
|
(test 'd (itake-right dotted 0))
|
|
(test (iq 1 2 3) (idrop-right dotted 0))
|
|
(test abcde (call-with-values (lambda () (isplit-at abcde 3)) iappend))
|
|
(test 'c (ilast (iq a b c)))
|
|
(test (iq c) (last-ipair (iq a b c))))
|
|
|
|
(test-group "ilists/misc"
|
|
(test 0 (ilength '()))
|
|
(test 3 (ilength (iq 1 2 3)))
|
|
(test (iq x y) (iappend (iq x) (iq y)))
|
|
(test (iq a b c d) (iappend (iq a b) (iq c d)))
|
|
(test (iq a) (iappend '() (iq a)))
|
|
(test (iq x y) (iappend (iq x y)))
|
|
(test '() (iappend))
|
|
(test (iq a b c d) (iconcatenate (iq (a b) (c d))))
|
|
(test (iq c b a) (ireverse (iq a b c)))
|
|
(test (iq (e (f)) d (b c) a) (ireverse (iq a (b c) d (e (f)))))
|
|
(test (ipair 2 (ipair 1 'd)) (iappend-reverse (iq 1 2) 'd))
|
|
(test (iq (one 1 odd) (two 2 even) (three 3 odd))
|
|
(izip (iq one two three) (iq 1 2 3) (iq odd even odd)))
|
|
(test (iq (1) (2) (3)) (izip (iq 1 2 3)))
|
|
(test (iq 1 2 3) (iunzip1 (iq (1) (2) (3))))
|
|
(test (iq (1 2 3) (one two three))
|
|
(call-with-values
|
|
(lambda () (iunzip2 (iq (1 one) (2 two) (3 three))))
|
|
ilist))
|
|
(test (iq (1 2 3) (one two three) (a b c))
|
|
(call-with-values
|
|
(lambda () (iunzip3 (iq (1 one a) (2 two b) (3 three c))))
|
|
ilist))
|
|
(test (iq (1 2 3) (one two three) (a b c) (4 5 6))
|
|
(call-with-values
|
|
(lambda () (iunzip4 (iq (1 one a 4) (2 two b 5) (3 three c 6))))
|
|
ilist))
|
|
(test (iq (1 2 3) (one two three) (a b c) (4 5 6) (#t #f #t))
|
|
(call-with-values
|
|
(lambda () (iunzip5 (iq (1 one a 4 #t) (2 two b 5 #f) (3 three c 6 #t))))
|
|
ilist))
|
|
(test 3 (icount even? (iq 3 1 4 1 5 9 2 5 6)))
|
|
(test 3 (icount < (iq 1 2 4 8) (iq 2 4 6 8 10 12 14 16))))
|
|
|
|
(test-group "ilists/folds"
|
|
;; We have to be careful to test both single-list and multiple-list
|
|
;; code paths, as they are different in this implementation.
|
|
(define squares (iq 1 4 9 16 25 36 49 64 81 100))
|
|
(define lis (iq 1 2 3))
|
|
(define (z x y ans) (ipair (ilist x y) ans))
|
|
(define z2 (let ((count 0)) (lambda (ignored) (set! count (+ count 1)) count)))
|
|
(test 6 (ifold + 0 lis))
|
|
(test (iq 3 2 1) (ifold ipair '() lis))
|
|
(test 2 (ifold
|
|
(lambda (x count) (if (symbol? x) (+ count 1) count))
|
|
0
|
|
(iq a 0 b)))
|
|
(test 4 (ifold
|
|
(lambda (s max-len) (max max-len (string-length s)))
|
|
0
|
|
(iq "ab" "abcd" "abc")))
|
|
(test 32 (ifold
|
|
(lambda (a b ans) (+ (* a b) ans))
|
|
0
|
|
(iq 1 2 3)
|
|
(iq 4 5 6)))
|
|
(test (iq (b d) (a c))
|
|
(ifold z '() (iq a b) (iq c d)))
|
|
(test lis (ifold-right ipair '() lis))
|
|
(test (iq 0 2 4) (ifold-right
|
|
(lambda (x l) (if (even? x) (ipair x l) l))
|
|
'()
|
|
(iq 0 1 2 3 4)))
|
|
(test (iq (a c) (b d))
|
|
(ifold-right z '() (iq a b) (iq c d)))
|
|
(test (iq (c) (b c) (a b c))
|
|
(ipair-fold ipair '() (iq a b c)))
|
|
(test (iq ((b) (d)) ((a b) (c d)))
|
|
(ipair-fold z '() (iq a b) (iq c d)))
|
|
(test (iq (a b c) (b c) (c))
|
|
(ipair-fold-right ipair '() (iq a b c)))
|
|
(test (iq ((a b) (c d)) ((b) (d)))
|
|
(ipair-fold-right z '() (iq a b) (iq c d)))
|
|
(test 5 (ireduce max 0 (iq 1 3 5 4 2 0)))
|
|
(test 1 (ireduce - 0 (iq 1 2)))
|
|
(test -1 (ireduce-right - 0 (iq 1 2)))
|
|
(test squares
|
|
(iunfold (lambda (x) (> x 10))
|
|
(lambda (x) (* x x))
|
|
(lambda (x) (+ x 1))
|
|
1))
|
|
(test squares
|
|
(iunfold-right zero?
|
|
(lambda (x) (* x x))
|
|
(lambda (x) (- x 1))
|
|
10))
|
|
(test (iq 1 2 3) (iunfold null-ilist? icar icdr (iq 1 2 3)))
|
|
(test (iq 3 2 1) (iunfold-right null-ilist? icar icdr (iq 1 2 3)))
|
|
(test (iq 1 2 3 4)
|
|
(iunfold null-ilist? icar icdr (iq 1 2) (lambda (x) (iq 3 4))))
|
|
(test (iq b e h) (imap icadr (iq (a b) (d e) (g h))))
|
|
(test (iq b e h) (imap-in-order icadr (iq (a b) (d e) (g h))))
|
|
(test (iq 5 7 9) (imap + (iq 1 2 3) (iq 4 5 6)))
|
|
(test (iq 5 7 9) (imap-in-order + (iq 1 2 3) (iq 4 5 6)))
|
|
(test (iq 1 2) (imap-in-order z2 (iq a b)))
|
|
(test '#(0 1 4 9 16)
|
|
(let ((v (make-vector 5)))
|
|
(ifor-each (lambda (i)
|
|
(vector-set! v i (* i i)))
|
|
(iq 0 1 2 3 4))
|
|
v))
|
|
(test '#(5 7 9 11 13)
|
|
(let ((v (make-vector 5)))
|
|
(ifor-each (lambda (i j)
|
|
(vector-set! v i (+ i j)))
|
|
(iq 0 1 2 3 4)
|
|
(iq 5 6 7 8 9))
|
|
v))
|
|
(test (iq 1 -1 3 -3 8 -8)
|
|
(iappend-map (lambda (x) (ilist x (- x))) (iq 1 3 8)))
|
|
(test (iq 1 4 2 5 3 6)
|
|
(iappend-map ilist (iq 1 2 3) (iq 4 5 6)))
|
|
(test (vector (iq 0 1 2 3 4) (iq 1 2 3 4) (iq 2 3 4) (iq 3 4) (iq 4))
|
|
(let ((v (make-vector 5)))
|
|
(ipair-for-each (lambda (lis) (vector-set! v (icar lis) lis)) (iq 0 1 2 3 4))
|
|
v))
|
|
(test (vector (iq 5 6 7 8 9) (iq 6 7 8 9) (iq 7 8 9) (iq 8 9) (iq 9))
|
|
(let ((v (make-vector 5)))
|
|
(ipair-for-each (lambda (i j) (vector-set! v (icar i) j))
|
|
(iq 0 1 2 3 4)
|
|
(iq 5 6 7 8 9))
|
|
v))
|
|
(test (iq 1 9 49)
|
|
(ifilter-map (lambda (x) (and (number? x) (* x x))) (iq a 1 b 3 c 7)))
|
|
(test (iq 5 7 9)
|
|
(ifilter-map
|
|
(lambda (x y) (and (number? x) (number? y) (+ x y)))
|
|
(iq 1 a 2 b 3 4)
|
|
(iq 4 0 5 y 6 z2))))
|
|
|
|
(test-group "ilists/filtering"
|
|
(test (iq 0 8 8 -4) (ifilter even? (iq 0 7 8 8 43 -4)))
|
|
(test (list (iq one four five) (iq 2 3 6))
|
|
(call-with-values
|
|
(lambda () (ipartition symbol? (iq one 2 3 four five 6)))
|
|
list))
|
|
(test (iq 7 43) (iremove even? (iq 0 7 8 8 43 -4))))
|
|
|
|
(test-group "ilists/searching"
|
|
(test 2 (ifind even? (iq 1 2 3)))
|
|
(test #t (iany even? (iq 1 2 3)))
|
|
(test #f (ifind even? (iq 1 7 3)))
|
|
(test #f (iany even? (iq 1 7 3)))
|
|
;;(test-error (ifind even? (ipair 1 (ipair 3 'x))))
|
|
;;(test-error (iany even? (ipair 1 (ipair 3 'x))))
|
|
(test 4 (ifind even? (iq 3 1 4 1 5 9)))
|
|
(test (iq -8 -5 0 0) (ifind-tail even? (iq 3 1 37 -8 -5 0 0)))
|
|
(test (iq 2 18) (itake-while even? (iq 2 18 3 10 22 9)))
|
|
(test (iq 3 10 22 9) (idrop-while even? (iq 2 18 3 10 22 9)))
|
|
(test (list (iq 2 18) (iq 3 10 22 9))
|
|
(call-with-values
|
|
(lambda () (ispan even? (iq 2 18 3 10 22 9)))
|
|
list))
|
|
(test (list (iq 3 1) (iq 4 1 5 9))
|
|
(call-with-values
|
|
(lambda () (ibreak even? (iq 3 1 4 1 5 9)))
|
|
list))
|
|
(test #t (iany integer? (iq a 3 b 2.7)))
|
|
(test #f (iany integer? (iq a 3.1 b 2.7)))
|
|
(test #t (iany < (iq 3 1 4 1 5) (iq 2 7 1 8 2)))
|
|
(test #t (ievery integer? (iq 1 2 3 4 5)))
|
|
(test #f (ievery integer? (iq 1 2 3 4.5 5)))
|
|
(test #t (ievery (lambda (a b) (< a b)) (iq 1 2 3) (iq 4 5 6)))
|
|
(test 2 (ilist-index even? (iq 3 1 4 1 5 9)))
|
|
(test 1 (ilist-index < (iq 3 1 4 1 5 9 2 5 6) (iq 2 7 1 8 2)))
|
|
(test #f (ilist-index = (iq 3 1 4 1 5 9 2 5 6) (iq 2 7 1 8 2)))
|
|
(test (iq a b c) (imemq 'a (iq a b c)))
|
|
(test (iq b c) (imemq 'b (iq a b c)))
|
|
(test #f (imemq 'a (iq b c d)))
|
|
(test #f (imemq (ilist 'a) (iq b (a) c)))
|
|
(test (iq (a) c) (imember (ilist 'a) (iq b (a) c)))
|
|
(test (iq 101 102) (imemv 101 (iq 100 101 102))))
|
|
|
|
(test-group "ilists/deletion"
|
|
(test (iq 1 2 4 5) (idelete 3 (iq 1 2 3 4 5)))
|
|
(test (iq 3 4 5) (idelete 5 (iq 3 4 5 6 7) <))
|
|
(test (iq a b c z) (idelete-duplicates (iq a b a c a b c z))))
|
|
|
|
(test-group "ilists/alists"
|
|
(define e (iq (a 1) (b 2) (c 3)))
|
|
(define e2 (iq (2 3) (5 7) (11 13)))
|
|
(test (iq a 1) (iassq 'a e))
|
|
(test (iq b 2) (iassq 'b e))
|
|
(test #f (iassq 'd e))
|
|
(test #f (iassq (ilist 'a) (iq ((a)) ((b)) ((c)))))
|
|
(test (iq (a)) (iassoc (ilist 'a) (iq ((a)) ((b)) ((c)))))
|
|
(test (iq 5 7) (iassv 5 e2))
|
|
(test (iq 11 13) (iassoc 5 e2 <))
|
|
(test (ipair (iq 1 1) e2) (ialist-cons 1 (ilist 1) e2))
|
|
(test (iq (2 3) (11 13)) (ialist-delete 5 e2))
|
|
(test (iq (2 3) (5 7)) (ialist-delete 5 e2 <))
|
|
)
|
|
|
|
(test-group "ilists/replacers"
|
|
(test (ipair 1 3) (replace-icar (ipair 2 3) 1))
|
|
(test (ipair 1 3) (replace-icdr (ipair 1 2) 3)))
|
|
|
|
(test-group "ilists/conversion"
|
|
(test (ipair 1 2) (pair->ipair '(1 . 2)))
|
|
(test '(1 . 2) (ipair->pair (ipair 1 2)))
|
|
(test (iq 1 2 3) (list->ilist '(1 2 3)))
|
|
(test '(1 2 3) (ilist->list (iq 1 2 3)))
|
|
(test (ipair 1 (ipair 2 3)) (list->ilist '(1 2 . 3)))
|
|
(test '(1 2 . 3) (ilist->list (ipair 1 (ipair 2 3))))
|
|
(test (ipair (ipair 1 2) (ipair 3 4)) (tree->itree '((1 . 2) . (3 . 4))))
|
|
(test '((1 . 2) . (3 . 4)) (itree->tree (ipair (ipair 1 2) (ipair 3 4))))
|
|
(test (ipair (ipair 1 2) (ipair 3 4)) (gtree->itree (cons (ipair 1 2) (ipair 3 4))))
|
|
(test '((1 . 2) . (3 . 4)) (gtree->tree (cons (ipair 1 2) (ipair 3 4))))
|
|
(test 6 (iapply + (iq 1 2 3)))
|
|
(test 15 (iapply + 1 2 (iq 3 4 5))))
|
|
|
|
))))
|