mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
259 lines
12 KiB
Scheme
259 lines
12 KiB
Scheme
(define-library (chibi iset-test)
|
|
(export run-tests)
|
|
(import (scheme base) (scheme write)
|
|
(except (srfi 1) make-list list-copy)
|
|
(chibi iset) (chibi iset optimize)
|
|
(chibi test))
|
|
(begin
|
|
(define (run-tests)
|
|
(define (test-name iset op)
|
|
(let ((out (open-output-string)))
|
|
(let* ((ls (iset->list iset))
|
|
(ls (if (> (length ls) 10)
|
|
`(,@(take ls 5) ... ,@(take-right ls 5))
|
|
ls)))
|
|
(write `(,(car op) (iset ,@ls) ,@(cdr op)) out)
|
|
(get-output-string out))))
|
|
|
|
(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
|
|
`(;; construction
|
|
((1 128 127))
|
|
((129 2 127))
|
|
((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: 64434 64449) (u: 65020 65021) (u #xFE62))
|
|
(() (u: 716 747) (u: 750 1084))
|
|
(() (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))
|
|
((1 2 3 4 5 6 7 8) (i 1 2 3 4) (= 1 2 3 4))
|
|
((1 3 4 5 6 7 8) (i 1 3 4) (= 1 3 4))
|
|
((1 2 4 5 6 7 8) (i 1 2 4) (= 1 2 4))
|
|
((1 2 3 5 6 7 8) (i 1 2 3) (= 1 2 3))
|
|
((1 2 3 4 6 7 8) (i 1 2 3 4) (= 1 2 3 4))
|
|
((1 2 3 6 7 8) (i 1 2 3) (= 1 2 3))
|
|
((1 3 6 8) (i 1 3) (= 1 3))
|
|
((1 2 3 4 1001 1002 1003 1004 2001 2002 2003 2004)
|
|
(i 0 1 2 3 4 10 1001 1002 3001)
|
|
(= 1 2 3 4 1001 1002))
|
|
((1 2 4 1001 1002 1003 1004 2001 2002 2003 2004)
|
|
(i 1 2 3 4 1001 1002)
|
|
(= 1 2 4 1001 1002))
|
|
((1 2 3 4 1001 1002 1004 2001 2002 2003 2004)
|
|
(i 1 2 3 4 1001 1003)
|
|
(= 1 2 3 4 1001))
|
|
((1 2 3 4 1001 1002 1003 1004 2001 2003 2004)
|
|
(i 1 2 3 4 1001 1004 1005 2000 2001)
|
|
(= 1 2 3 4 1001 1004 2001))
|
|
((0 1 2 3 4 5 6 7 8 9
|
|
101 102 103 104 105
|
|
1000 1001 1002 1003 1004 1005 1006 1007 1008 1009)
|
|
(i 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120)
|
|
(= 101 102 103 104 105))
|
|
;; 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))
|
|
((1 2 3 4 5 6 7 8) (d 1 2 3 4) (= 5 6 7 8))
|
|
((1 3 4 5 6 7 8) (d 1 3 4) (= 5 6 7 8))
|
|
((1 2 4 5 6 7 8) (d 1 2 4) (= 5 6 7 8))
|
|
((1 2 3 5 6 7 8) (d 1 2 3) (= 5 6 7 8))
|
|
((1 2 3 4 6 7 8) (d 1 2 3 4) (= 6 7 8))
|
|
((1 2 3 4 5 7 8) (d 1 2 3 4) (= 5 7 8))
|
|
((1 2 3 4 5 6 8) (d 1 2 3 4) (= 5 6 8))
|
|
((1 2 3 6 7 8) (d 1 2 3) (= 6 7 8))
|
|
((1 3 6 8) (d 1 3) (= 6 8))
|
|
((1 2 3 4 1001 1002 1003 1004 2001 2002 2003 2004)
|
|
(d 1 2 3 4 1001 1002)
|
|
(= 1003 1004 2001 2002 2003 2004))
|
|
((1 2 4 1001 1002 1003 1004 2001 2002 2003 2004)
|
|
(d 1 2 4 1001 1002)
|
|
(= 1003 1004 2001 2002 2003 2004))
|
|
((1 2 3 4 1001 1002 1004 2001 2002 2003 2004)
|
|
(d 1 2 3 4 1001 1002)
|
|
(= 1004 2001 2002 2003 2004))
|
|
((1 2 3 4 1001 1002 1003 1004 2001 2003 2004)
|
|
(d 1 2 3 4 1001 1002)
|
|
(= 1003 1004 2001 2003 2004))
|
|
;; map
|
|
((1 2 3) (m ,(lambda (x) (+ x 1))) (= 2 3 4))
|
|
)))
|
|
(for-each
|
|
(lambda (tst)
|
|
(let* ((ls (car tst))
|
|
(is (list->iset ls))
|
|
(ls2 (delete-duplicates ls =)))
|
|
;; initial creation and sanity checks
|
|
(test-assert (lset= equal? ls2 (iset->list is)))
|
|
(test (length ls2) (iset-size is))
|
|
(test-assert (let ((out (open-output-string)))
|
|
(display "init: " out)
|
|
(write ls out)
|
|
(get-output-string out))
|
|
(every
|
|
(lambda (x) (iset-contains? is x))
|
|
ls))
|
|
(test (iset-contains? is 42) (member 42 ls))
|
|
;; additional operations
|
|
(for-each
|
|
(lambda (op)
|
|
(let ((name (test-name is op)))
|
|
(case (car op)
|
|
((+)
|
|
(for-each
|
|
(lambda (x) (iset-adjoin! is x))
|
|
(cdr op))
|
|
(test-assert name (iset-contains? is (cadr op))))
|
|
((-)
|
|
(for-each
|
|
(lambda (x) (iset-delete! is x))
|
|
(cdr 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-assert name
|
|
(every (lambda (x) (iset-contains? is x)) (cdr op))))
|
|
((!?)
|
|
(test-assert name
|
|
(every (lambda (x) (not (iset-contains? is x))) (cdr op))))
|
|
((d)
|
|
(set! is (iset-difference is (list->iset (cdr op))))
|
|
(test-assert name
|
|
(every
|
|
(lambda (x) (not (iset-contains? is x)))
|
|
(cdr op))))
|
|
((i) (set! is (iset-intersection is (list->iset (cdr op)))))
|
|
((u u:)
|
|
(let ((arg (cond ((eq? 'u: (car op))
|
|
(make-iset (cadr op) (car (cddr op))))
|
|
((iset? (cadr op)) (cadr op))
|
|
(else (list->iset (cdr op))))))
|
|
(set! is (iset-union is arg)))
|
|
(test-assert name
|
|
(every (lambda (x)
|
|
(or (not (integer? x))
|
|
(iset-contains? is x)))
|
|
(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)))
|
|
(else (error "unknown operation" (car op))))))
|
|
(cdr tst))
|
|
;; optimization
|
|
(let* ((is2 (iset-optimize is))
|
|
(is3 (iset-balance is))
|
|
(is4 (iset-balance is2)))
|
|
(test-assert (iset= is is2))
|
|
(test-assert (iset= is is3))
|
|
(test-assert (iset= is is4)))))
|
|
tests))
|
|
|
|
(let ((a (%make-iset 65 90 #f #f (%make-iset 97 122 #f #f #f)))
|
|
(b (list->iset '(45 46 95 126))))
|
|
(test-assert (iset-contains? (iset-union a b) 119))
|
|
(test-assert (iset-contains? (iset-union b a) 119)))
|
|
|
|
(let* ((elts '(0 1 5 27 42 113 114 256))
|
|
(is (list->iset elts)))
|
|
(test (iota (length elts))
|
|
(map (lambda (elt) (iset-rank is elt)) elts))
|
|
(test elts
|
|
(map (lambda (i) (iset-select is i)) (iota (length elts)))))
|
|
|
|
(let* ((elts '(903 595 694 581 91 628 648 152 188 29 347 876 381 945 508 890 816 654 871 228 200 397 116 952 60 878 361 205 691 318 87 998 35 886 580 787 856 535 964 133 245 314 711 598 180 984 458 235 599 692 568 1 740 514 995 930 625 638 881 997 412 151 195 512 857 948 956 750 896 813 988 40 85 426 740 83 294 249 235 45 20 784 837 640 56 519 211 780 771 684 408 510 677 773 574 114 537 934 477 136))
|
|
(is (list->iset elts)))
|
|
(test elts
|
|
(map (lambda (i) (iset-select is i))
|
|
(map (lambda (elt) (iset-rank is elt)) elts))))
|
|
|
|
(test-end))))
|