From 29b461bb4478e4ec913006c03be5f60328164a13 Mon Sep 17 00:00:00 2001 From: Travis Cross Date: Thu, 19 Jan 2012 16:11:12 +0000 Subject: [PATCH] Add tests from SRFI-1 examples. --- Makefile | 3 + tests/srfi-1-tests.scm | 159 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 162 insertions(+) create mode 100644 tests/srfi-1-tests.scm diff --git a/Makefile b/Makefile index 43e2fdc7..54f5f327 100644 --- a/Makefile +++ b/Makefile @@ -271,6 +271,9 @@ test-loop: chibi-scheme$(EXE) test-sort: chibi-scheme$(EXE) lib/srfi/33/bit$(SO) $(CHIBI) -xscheme tests/sort-tests.scm +test-srfi-1: chibi-scheme$(EXE) + $(CHIBI) -xscheme tests/srfi-1-tests.scm + test-records: chibi-scheme$(EXE) $(CHIBI) -xscheme tests/record-tests.scm diff --git a/tests/srfi-1-tests.scm b/tests/srfi-1-tests.scm new file mode 100644 index 00000000..f47b362e --- /dev/null +++ b/tests/srfi-1-tests.scm @@ -0,0 +1,159 @@ +(import (scheme) (chibi test) (srfi 1)) + +(test-begin "srfi-1") + +;; srfi-1 examples +;; http://srfi.schemers.org/srfi-1/srfi-1.html +(test '(a) (cons 'a '())) +(test '((a) b c d) (cons '(a) '(b c d))) +(test '("a" b c) (cons "a" '(b c))) +(test '(a . 3) (cons 'a 3)) +(test '((a b) . c) (cons '(a b) 'c)) +(test '(a 7 c) (list 'a (+ 3 4) 'c)) +(test '() (list)) +(test '(a b c) (xcons '(b c) 'a)) +(test '(1 2 3 . 4) (cons* 1 2 3 4)) +(test '1 (cons* 1)) +(test '(c c c c) (make-list 4 'c)) +(test '(0 1 2 3) (list-tabulate 4 values)) +(test '(z q z q z q) (take (circular-list 'z 'q) 6)) +(test '(0 1 2 3 4) (iota 5)) +(test '(0 -0.1 -0.2 -0.3 -0.4) (iota 5 0 -0.1)) +(test '#t (pair? '(a . b))) +(test '#t (pair? '(a b c))) +(test '#f (pair? '())) +(test '#f (pair? '#(a b))) +(test '#f (pair? 7)) +(test '#f (pair? 'a)) +(test '#t (list= eq?)) +(test '#t (list= eq? '(a))) +(test 'a (car '(a b c))) +(test '(b c) (cdr '(a b c))) +(test '(a) (car '((a) b c d))) +(test '(b c d) (cdr '((a) b c d))) +(test '1 (car '(1 . 2))) +(test '2 (cdr '(1 . 2))) +(test-error (car '())) +(test-error (cdr '())) +(test 'c (list-ref '(a b c d) 2)) +(test 'c (third '(a b c d e))) +(test '(a b) (take '(a b c d e) 2)) +(test '(c d e) (drop '(a b c d e) 2)) +(test '(1 2) (take '(1 2 3 . d) 2)) +(test '(3 . d) (drop '(1 2 3 . d) 2)) +(test '(1 2 3) (take '(1 2 3 . d) 3)) +(test 'd (drop '(1 2 3 . d) 3)) +(test '(d e) (take-right '(a b c d e) 2)) +(test '(a b c) (drop-right '(a b c d e) 2)) +(test '(2 3 . d) (take-right '(1 2 3 . d) 2)) +(test '(1) (drop-right '(1 2 3 . d) 2)) +(test 'd (take-right '(1 2 3 . d) 0)) +(test '(1 2 3) (drop-right '(1 2 3 . d) 0)) +(test-assert (member (take! (circular-list 1 3 5) 8) '((1 3) (1 3 5 1 3 5 1 3)) equal?)) +(test-values (values '(a b c) '(d e f g h)) (split-at '(a b c d e f g h) 3)) +(test 'c (last '(a b c))) +(test '(c) (last-pair '(a b c))) +(test '(x y) (append '(x) '(y))) +(test '(a b c d) (append '(a) '(b c d))) +(test '(a (b) (c)) (append '(a (b)) '((c)))) +(test '(a b c . d) (append '(a b) '(c . d))) +(test 'a (append '() 'a)) +(test '(x y) (append '(x y))) +(test '() (append)) +(test '(c b a) (reverse '(a b c))) +(test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f))))) +(test '((one 1 odd) (two 2 even) (three 3 odd)) (zip '(one two three) '(1 2 3) '(odd even odd even odd even odd even))) +(test '((1) (2) (3)) (zip '(1 2 3))) +(test '((3 #f) (1 #t) (4 #f) (1 #t)) (zip '(3 1 4 1) (circular-list #f #t))) +(test-values (values '(1 2 3) '(one two three)) (unzip2 '((1 one) (2 two) (3 three)))) +(test '3 (count even? '(3 1 4 1 5 9 2 5 6))) +(test '3 (count < '(1 2 4 8) '(2 4 6 8 10 12 14 16))) +(test '2 (count < '(3 1 4 1) (circular-list 1 10))) +(test '(c 3 b 2 a 1) (fold cons* '() '(a b c) '(1 2 3 4 5))) +(test '(a 1 b 2 c 3) (fold-right cons* '() '(a b c) '(1 2 3 4 5))) +(test '((a b c) (b c) (c)) (pair-fold-right cons '() '(a b c))) +(test '(b e h) (map cadr '((a b) (d e) (g h)))) +(test '(1 4 27 256 3125) (map (lambda (n) (expt n n)) '(1 2 3 4 5))) +(test '(5 7 9) (map + '(1 2 3) '(4 5 6))) +(test-assert (member (let ((count 0)) (map (lambda (ignored) (set! count (+ count 1)) count) '(a b))) '((1 2) (2 1)) equal?)) +(test '(4 1 5 1) (map + '(3 1 4 1) (circular-list 1 0))) +(test '#(0 1 4 9 16) (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v)) +(test '(1 -1 3 -3 8 -8) (append-map (lambda (x) (list x (- x))) '(1 3 8))) +(test '(1 -1 3 -3 8 -8) (apply append (map (lambda (x) (list x (- x))) '(1 3 8)))) +(test '(1 -1 3 -3 8 -8) (append-map! (lambda (x) (list x (- x))) '(1 3 8))) +(test '(1 -1 3 -3 8 -8) (apply append! (map (lambda (x) (list x (- x))) '(1 3 8)))) +(test "pair-for-each-1" '((a b c) (b c) (c)) + (let ((a '())) + (pair-for-each (lambda (x) (set! a (cons x a))) '(a b c)) + (reverse a))) +(test '(1 9 49) (filter-map (lambda (x) (and (number? x) (* x x))) '(a 1 b 3 c 7))) +(test '(0 8 8 -4) (filter even? '(0 7 8 8 43 -4))) +(test-values (values '(one four five) '(2 3 6)) (partition symbol? '(one 2 3 four five 6))) +(test '(7 43) (remove even? '(0 7 8 8 43 -4))) +(test '2 (find even? '(1 2 3))) +(test '#t (any even? '(1 2 3))) +(test '#f (find even? '(1 7 3))) +(test '#f (any even? '(1 7 3))) +(test-error (find even? '(1 3 . x))) +(test-error (any even? '(1 3 . x))) +;(test 'error/undefined (find even? '(1 2 . x))) +;(test 'error/undefined (any even? '(1 2 . x))) ; success, error or other +(test '6 (find even? (circular-list 1 6 3))) +(test '#t (any even? (circular-list 1 6 3))) +;(test-error (find even? (circular-list 1 3))) ; divergent +;(test-error (any even? (circular-list 1 3))) ; divergent +(test '4 (find even? '(3 1 4 1 5 9))) +(test '(-8 -5 0 0) (find-tail even? '(3 1 37 -8 -5 0 0))) +(test '#f (find-tail even? '(3 1 37 -5))) +(test '(2 18) (take-while even? '(2 18 3 10 22 9))) +(test '(3 10 22 9) (drop-while even? '(2 18 3 10 22 9))) +(test-values (values '(2 18) '(3 10 22 9)) (span even? '(2 18 3 10 22 9))) +(test-values (values '(3 1) '(4 1 5 9)) (break even? '(3 1 4 1 5 9))) +(test '#t (any integer? '(a 3 b 2.7))) +(test '#f (any integer? '(a 3.1 b 2.7))) +(test '#t (any < '(3 1 4 1 5) '(2 7 1 8 2))) +(test '2 (list-index even? '(3 1 4 1 5 9))) +(test '1 (list-index < '(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) +(test '#f (list-index = '(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) +(test '(a b c) (memq 'a '(a b c))) +(test '(b c) (memq 'b '(a b c))) +(test '#f (memq 'a '(b c d))) +(test '#f (memq (list 'a) '(b (a) c))) +(test '((a) c) (member (list 'a) '(b (a) c))) +;(test '*unspecified* (memq 101 '(100 101 102))) +(test '(101 102) (memv 101 '(100 101 102))) +(test '(a b c z) (delete-duplicates '(a b a c a b c z))) +(test '((a . 3) (b . 7) (c . 1)) (delete-duplicates '((a . 3) (b . 7) (a . 9) (c . 1)) (lambda (x y) (eq? (car x) (car y))))) +(let ((e '((a 1) (b 2) (c 3)))) + (test '(a 1) (assq 'a e)) + (test '(b 2) (assq 'b e)) + (test '#f (assq 'd e)) + (test '#f (assq (list 'a) '(((a)) ((b)) ((c))))) + (test '((a)) (assoc (list 'a) '(((a)) ((b)) ((c))))) + ;(test '*unspecified* (assq 5 '((2 3) (5 7) (11 13)))) + (test '(5 7) (assv 5 '((2 3) (5 7) (11 13))))) +(test '#t (lset<= eq? '(a) '(a b a) '(a b c c))) +(test '#t (lset<= eq?)) +(test '#t (lset<= eq? '(a))) +(test '#t (lset= eq? '(b e a) '(a e b) '(e e b a))) +(test '#t (lset= eq?)) +(test '#t (lset= eq? '(a))) +(test '(u o i a b c d c e) (lset-adjoin eq? '(a b c d c e) 'a 'e 'i 'o 'u)) +(test '(u o i a b c d e) (lset-union eq? '(a b c d e) '(a e i o u))) +(test '(x a a c) (lset-union eq? '(a a c) '(x a x))) +(test '() (lset-union eq?)) +(test '(a b c) (lset-union eq? '(a b c))) +(test '(a e) (lset-intersection eq? '(a b c d e) '(a e i o u))) +(test '(a x a) (lset-intersection eq? '(a x y a) '(x a x z))) +(test '(a b c) (lset-intersection eq? '(a b c))) +(test '(b c d) (lset-difference eq? '(a b c d e) '(a e i o u))) +(test '(a b c) (lset-difference eq? '(a b c))) +(test '(d c b i o u) (lset-xor eq? '(a b c d e) '(a e i o u))) +(test '() (lset-xor eq?)) +(test '(a b c d e) (lset-xor eq? '(a b c d e))) +(let ((f (lambda () (list 'not-a-constant-list))) + (g (lambda () '(constant-list)))) + ;(test '*unspecified* (set-car! (f) 3)) + (test-error (set-car! (g) 3))) + +(test-end)