(cond-expand (modules (import (chibi) (chibi iset) (chibi iset optimize) (srfi 1) (chibi test))) (else #f)) (define (test-name iset op) (call-with-output-string (lambda (out) (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))))) (test-begin "iset") (let ((tests `((() (+ 99) (u 3 50) (? 99)) (() (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)) ((129 2 127)) ((1 -128 -126)) (() (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)) ))) (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)) (for-each (lambda (x) (test-assert (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) ((+) (iset-adjoin! is (cadr op)) (test-assert name (iset-contains? is (cadr op)))) ((-) (iset-delete! is (cadr op)) (test-assert name (not (iset-contains? is (cadr op))))) ((?) (test name (if (pair? (cddr op)) (car (cddr op)) #t) (iset-contains? is (cadr op)))) ((d) (set! is (iset-difference is (list->iset (cdr op)))) (for-each (lambda (x) (test-assert name (iset-contains? is x))) (cdr op))) ((i) (set! is (iset-intersection is (list->iset (cdr op))))) ((s) (test (iset-size is) (cadr 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))) (for-each (lambda (x) (if (integer? x) (test-assert name (iset-contains? is x)))) (cdr 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))) (test-end)