Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 06:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Expanding iset tests.

Browse source
This commit is contained in:
Alex Shinn 2015-01-22 17:37:08 +09:00
parent 51fb7423bd
commit 05e5e1d499
1 changed files with 125 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

200
tests/iset-tests.scm
View file

@ -15,24 +15,105 @@
(test-begin "iset") (test-begin "iset")
;; Tests to perform repeated operations on an iset. The first element
;; in each list is a list of integers to initialize the set `is', which
;; we generate and verify the size and round-trip list conversion.
;; Subsequent elements are abbreviated operations on is:
;;
;; (+ a ...) (iset-adjoin! a) ...
;; (- a ...) (iset-delete! a) ...
;; (= a ...) (test (list a ...) (iset->list is))
;; (<= a ...) (test-assert (iset<= is (iset a ...)))
;; (? a ...) (test-assert (iset-contains? is a)) ...
;; (!? a ...) (test-not (iset-contains? is a)) ...
;; (u a ...) (iset-union is (iset a ...))
;; (u: a b) (iset-union is (make-iset a b))
;; (i a ...) (iset-intersection is (iset a ...))
;; (d a ...) (iset-difference is (iset a ...))
;; (m f) (iset-map f is)
;; (s size) (test size (iset-size iset))
;; (z [empty?]) (test empty? (iset-empty? iset))
(let ((tests (let ((tests
`((() (+ 99) (u 3 50) (? 99)) `(;; construction
(() (u 1) (u 1000) (u -1000) (u 3) (u -1))
((17 29) (u 7 29))
((2 3 4) (u 1 2 3 4 5))
((1 2 3 4 5) (u 2 3 4))
((0) (z #f) (- 0) (z))
((0 1 2) (- 1) (- 2) (? 0))
((1 2 3 1000 2000) (u 1 4))
((1 2 3 1000 1005))
((97308 97827 97845 97827))
((1 128 127)) ((1 128 127))
((129 2 127)) ((129 2 127))
((1 -128 -126)) ((1 -128 -126))
((1 2 3 1000 1005))
((97308 97827 97845 97827))
((1 2 3 4 5 6 7 8))
((2 3 4 5 6 7 8))
((1 3 4 5 6 7 8))
((1 2 4 5 6 7 8))
((1 2 3 5 6 7 8))
((1 2 3 4 6 7 8))
((1 2 3 4 5 7 8))
((1 2 3 4 5 6 8))
((1 2 3 4 5 6 7))
;; ordering
((97) (<= 97 117))
((117) (<= 97 117))
;; individual elements
(() (+ 99) (u 3 50) (? 99))
(() (+ 1) (+ 1000) (+ -1000) (+ 3) (+ -1))
((0) (z #f) (- 0) (z))
((0 1 2) (- 1) (- 2) (? 0))
;; union
((17 29) (u 7 29))
((2 3 4) (u 1 2 3 4 5))
((1 2 3 4 5) (u 2 3 4))
((1 2 3 1000 2000) (u 1 4))
((1 3) (u 1 4) (= 1 3 4))
((1 3) (u 3 4) (= 1 3 4))
((1) (u 1 3) (= 1 3))
((3) (u 1 3) (= 1 3))
((1 4) (u 3 4 5) (= 1 3 4 5))
((1 2 3 4) (u 5 6 7 8) (= 1 2 3 4 5 6 7 8))
((1 3 4) (u 5 6 7 8) (= 1 3 4 5 6 7 8))
((1 2 4) (u 5 6 7 8) (= 1 2 4 5 6 7 8))
((1 2 3) (u 5 6 7 8) (= 1 2 3 5 6 7 8))
((1 2 3 4) (u 6 7 8) (= 1 2 3 4 6 7 8))
((1 2 3 4) (u 5 7 8) (= 1 2 3 4 5 7 8))
((1 2 3 4) (u 5 6 8) (= 1 2 3 4 5 6 8))
((1 2 3) (u 6 7 8) (= 1 2 3 6 7 8))
((1 3) (u 6 8) (= 1 3 6 8))
((1 2 3 4 1001 1002)
(u 1003 1004 2001 2002 2003 2004)
(= 1 2 3 4 1001 1002 1003 1004 2001 2002 2003 2004))
((1 2 4 1001 1002)
(u 1003 1004 2001 2002 2003 2004)
(= 1 2 4 1001 1002 1003 1004 2001 2002 2003 2004))
((1 2 3 4 1001 1002)
(u 1004 2001 2002 2003 2004)
(= 1 2 3 4 1001 1002 1004 2001 2002 2003 2004))
((1 2 3 4 1001 1002)
(u 1003 1004 2001 2003 2004)
(= 1 2 3 4 1001 1002 1003 1004 2001 2003 2004))
(() (u: 349 680) (u: 682 685)) (() (u: 349 680) (u: 682 685))
(() (u: 64434 64449) (u: 65020 65021) (u #xFE62)) (() (u: 64434 64449) (u: 65020 65021) (u #xFE62))
(() (u: 716 747) (u: 750 1084)) (() (u: 716 747) (u: 750 1084))
(() (u: 48 57) (u: 65 90) (u: 97 122) (u 45 46 95 126) (? 119)) (() (u: 48 57) (u: 65 90) (u: 97 122) (u 45 46 95 126) (? 119))
;; intersection
((1 2 3 4 5) (i 1) (= 1))
((1 2 3 4 5) (i 1 2) (= 1 2))
((1 2 3 4 5) (i 1 2 3) (= 1 2 3))
((1 2 3 4 5) (i 2 3) (= 2 3))
((1 2 3 4 5) (i 2 3 4) (= 2 3 4))
((1 2 3 4 5) (i 5) (= 5))
((1 2 3 4 5) (i 4 5) (= 4 5))
((1 2 3 4 5) (i 1 2 3 4 5) (= 1 2 3 4 5))
((1 2 3 4 5) (i 0 1 5 6) (= 1 5))
;; difference
((1 2 3 4 5) (d 1) (!? 0) (? 2 3 4 5) (!? 6))
((1 2 3 4 5) (d 1 2) (!? 0) (? 3 4 5) (!? 6))
((1 2 3 4 5) (d 1 2 3) (!? 0) (? 4 4) (!? 6))
((1 2 3 4 5) (d 2 3) (!? 0) (? 1 4 5) (!? 6))
((1 2 3 4 5) (d 2 3 4) (!? 0) (? 1 5) (!? 6))
((1 2 3 4 5) (d 5) (!? 0) (? 1 2 3 4) (!? 6))
((1 2 3 4 5) (d 4 5) (!? 0) (? 1 2 3) (!? 6))
((1 2 3 4 5) (d 1 2 3 4 5) (z))
((1 2 3 4 5) (d 0 1 5 6) (? 2 3 4))
;; map
((1 2 3) (m ,(lambda (x) (+ x 1))) (= 2 3 4))
))) )))
(for-each (for-each
(lambda (tst) (lambda (tst)
@ -42,9 +123,13 @@
;; initial creation and sanity checks ;; initial creation and sanity checks
(test-assert (lset= equal? ls2 (iset->list is))) (test-assert (lset= equal? ls2 (iset->list is)))
(test (length ls2) (iset-size is)) (test (length ls2) (iset-size is))
(for-each (test-assert (call-with-output-string
(lambda (x) (test-assert (iset-contains? is x))) (lambda (out)
ls) (display "init: " out)
(write ls out)))
(every
(lambda (x) (iset-contains? is x))
ls))
(test (iset-contains? is 42) (member 42 ls)) (test (iset-contains? is 42) (member 42 ls))
;; additional operations ;; additional operations
(for-each (for-each
@ -52,31 +137,46 @@
(let ((name (test-name is op))) (let ((name (test-name is op)))
(case (car op) (case (car op)
((+) ((+)
(iset-adjoin! is (cadr op)) (for-each
(lambda (x) (iset-adjoin! is x))
(cdr op))
(test-assert name (iset-contains? is (cadr op)))) (test-assert name (iset-contains? is (cadr op))))
((-) ((-)
(iset-delete! is (cadr op)) (for-each
(lambda (x) (iset-delete! is x))
(cdr op))
(test-assert name (not (iset-contains? is (cadr op))))) (test-assert name (not (iset-contains? is (cadr op)))))
((=)
(test name (cdr op) (iset->list is))
(test-assert name (iset= (list->iset (cdr op)) is)))
((<=)
(test-assert name (iset<= is (list->iset (cdr op)))))
((?) ((?)
(test name (if (pair? (cddr op)) (car (cddr op)) #t) (test-assert name
(iset-contains? is (cadr op)))) (every (lambda (x) (iset-contains? is x)) (cdr op))))
((!?)
(test-assert name
(every (lambda (x) (not (iset-contains? is x))) (cdr op))))
((d) ((d)
(set! is (iset-difference is (list->iset (cdr op)))) (set! is (iset-difference is (list->iset (cdr op))))
(for-each (lambda (x) (test-assert name (iset-contains? is x))) (test-assert name
(cdr op))) (every
(lambda (x) (not (iset-contains? is x)))
(cdr op))))
((i) (set! is (iset-intersection is (list->iset (cdr op))))) ((i) (set! is (iset-intersection is (list->iset (cdr op)))))
((s) (test (iset-size is) (cadr op)))
((u u:) ((u u:)
(let ((arg (cond ((eq? 'u: (car op)) (let ((arg (cond ((eq? 'u: (car op))
(make-iset (cadr op) (car (cddr op)))) (make-iset (cadr op) (car (cddr op))))
((iset? (cadr op)) (cadr op)) ((iset? (cadr op)) (cadr op))
(else (list->iset (cdr op)))))) (else (list->iset (cdr op))))))
(set! is (iset-union is arg))) (set! is (iset-union is arg)))
(for-each (test-assert name
(lambda (x) (every (lambda (x)
(if (integer? x) (or (not (integer? x))
(test-assert name (iset-contains? is x)))) (iset-contains? is x)))
(cdr op))) (cdr op))))
((m) (set! is (iset-map (cadr op) is)))
((s) (test (iset-size is) (cadr op)))
((z) (test (iset-empty? is) (if (pair? (cdr op)) (cadr op) #t))) ((z) (test (iset-empty? is) (if (pair? (cdr op)) (cadr op) #t)))
(else (error "unknown operation" (car op)))))) (else (error "unknown operation" (car op))))))
(cdr tst)) (cdr tst))
@ -94,54 +194,4 @@
(test-assert (iset-contains? (iset-union a b) 119)) (test-assert (iset-contains? (iset-union a b) 119))
(test-assert (iset-contains? (iset-union b a) 119))) (test-assert (iset-contains? (iset-union b a) 119)))
(test '(2 3 4)
(iset->list (iset-map (lambda (i) (+ i 1)) (iset 1 2 3))))
(test-assert (iset<= (iset 97) (iset 97 117)))
(test-assert (iset<= (iset 117) (iset 97 117)))
(test-assert (iset= (iset-union (iset 1 3) (iset 3 4)) (iset 1 3 4)))
(test-assert (iset= (iset-union (iset 3) (iset 1 3)) (iset 1 3)))
(test-assert (iset= (iset-union (iset 1 4) (iset 3 4 5)) (iset 1 3 4 5)))
(test '(1 2 3 4 5 6 7 8) (iset->list (iset 1 2 3 4 5 6 7 8)))
(test '(1 3 4 5 6 7 8) (iset->list (iset 1 3 4 5 6 7 8)))
(test '(1 2 4 5 6 7 8) (iset->list (iset 1 2 4 5 6 7 8)))
(test '(1 2 3 5 6 7 8) (iset->list (iset 1 2 3 5 6 7 8)))
(test '(1 2 3 4 6 7 8) (iset->list (iset 1 2 3 4 6 7 8)))
(test '(1 2 3 4 5 7 8) (iset->list (iset 1 2 3 4 5 7 8)))
(test '(1 2 3 4 5 6 8) (iset->list (iset 1 2 3 4 5 6 8)))
(test '(1 2 3 4 5 6 7 8)
(iset->list (iset-union (iset 1 2 3 4) (iset 5 6 7 8))))
(test '(1 3 4 5 6 7 8)
(iset->list (iset-union (iset 1 3 4) (iset 5 6 7 8))))
(test '(1 2 4 5 6 7 8)
(iset->list (iset-union (iset 1 2 4) (iset 5 6 7 8))))
(test '(1 2 3 5 6 7 8)
(iset->list (iset-union (iset 1 2 3) (iset 5 6 7 8))))
(test '(1 2 3 4 6 7 8)
(iset->list (iset-union (iset 1 2 3 4) (iset 6 7 8))))
(test '(1 2 3 4 5 7 8)
(iset->list (iset-union (iset 1 2 3 4) (iset 5 7 8))))
(test '(1 2 3 4 5 6 8)
(iset->list (iset-union (iset 1 2 3 4) (iset 5 6 8))))
(test '(1 2 3 6 7 8)
(iset->list (iset-union (iset 1 2 3) (iset 6 7 8))))
(test '(1 3 6 8)
(iset->list (iset-union (iset 1 3) (iset 6 8))))
(test '(1 2 3 4 1001 1002 1003 1004 2001 2002 2003 2004)
(iset->list (iset-union (iset 1 2 3 4 1001 1002)
(iset 1003 1004 2001 2002 2003 2004))))
(test '(1 2 4 1001 1002 1003 1004 2001 2002 2003 2004)
(iset->list (iset-union (iset 1 2 4 1001 1002)
(iset 1003 1004 2001 2002 2003 2004))))
(test '(1 2 3 4 1001 1002 1004 2001 2002 2003 2004)
(iset->list (iset-union (iset 1 2 3 4 1001 1002)
(iset 1004 2001 2002 2003 2004))))
(test '(1 2 3 4 1001 1002 1003 1004 2001 2003 2004)
(iset->list (iset-union (iset 1 2 3 4 1001 1002)
(iset 1003 1004 2001 2003 2004))))
(test-end) (test-end)