diff options
Diffstat (limited to 'tests/run.scm')
| -rw-r--r-- | tests/run.scm | 56 |
1 files changed, 47 insertions, 9 deletions
diff --git a/tests/run.scm b/tests/run.scm index 06f4f2c..e2bf76b 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -1,7 +1,26 @@ ;; (load "../slsets.scm") -(import slsets test) +(import slsets test (chicken plist)) + +(define all-symbols '(a b c d e i o u x y z)) +(define all-plist-entries (apply append (map symbol-plist all-symbols))) + +(define (filter pred lst) + (let lp ((lst lst) + (res '())) + (cond ((null? lst) (reverse res)) + ((not (pred (car lst))) (lp (cdr lst) res)) + (else (lp (cdr lst) (cons (car lst) res)))))) + +(define (clean? lst) + (if (null? lst) + #t + (and (null? (filter (lambda (x) (not (memq x all-plist-entries))) (symbol-plist (car lst)))) + (clean? (cdr lst))))) (test-group "slsets" + (test-group "initially, all symbols used in any test are clean" + (test-assert (clean? all-symbols))) + (test-group "slset<=" (test-group "examples from srfi-1 document" (test-assert (slset<= '(a) '(a b a) '(a b c c))) @@ -9,7 +28,9 @@ (test-assert "trivial case one arg" (slset<= '(a)))) (test-group "negatives" (test-assert (not (slset<= '(a b a) '(a b c c) '(a)))) - (test-assert (not (slset<= '(a b) '(a c)))))) + (test-assert (not (slset<= '(a b) '(a c))))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b c))))) (test-group "slset=" (test-group "examples from srfi-1 document" @@ -19,7 +40,9 @@ (test-group "negatives" (test-assert (not (slset= '(b e a) '(a e b x) '(e e b a)))) (test-assert (not (slset= '(b e a x) '(a e b) '(e e b a)))) - (test-assert (not (slset= '(b e a) '(a e b) '(e e b a x)))))) + (test-assert (not (slset= '(b e a) '(a e b) '(e e b a x))))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b e x))))) (test-group "slset-adjoin" (test-group "example from srfi-1 document" @@ -29,7 +52,9 @@ (test-group "result shares a common tail with the list argument" (let* ((lst '(a b c d c e)) (result (slset-adjoin lst 'a 'x 'e 'b))) - (test-assert (eq? lst (cdr result)))))) + (test-assert (eq? lst (cdr result))))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b c d e i o u x))))) (test-group "slset-union" (test-group "examples from srfi-1 document" @@ -42,7 +67,9 @@ (slset-union)) (test "trivial case one arg" '(a b c) - (slset-union '(a b c))))) + (slset-union '(a b c)))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b c d e i o u x))))) (test-group "slset-xor" (test-group "examples from srfi-1 document" @@ -58,7 +85,9 @@ (test "for multiple lists, returns elements that appear in an odd number of lists" '(c d i u e x) (slset-xor '(a b c d e) '(a e i o u) '(b o e) '(x))) (test "duplicates in lists are preserved" - '(b b c d d i o u o) (slset-xor '(a b b c d e d) '(a e i o u o))))) + '(b b c d d i o u o) (slset-xor '(a b b c d e d) '(a e i o u o)))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b c d e i o u x))))) (test-group "slset-difference" (test-group "examples from srfi-1 document" @@ -77,7 +106,9 @@ (slset-difference '() '(a b b c d e))) (test "empty list is still empty after other args" '() - (slset-difference '() '(a b) '(c d e) '())))) + (slset-difference '() '(a b) '(c d e) '()))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b c d e i o u x y z))))) (test-group "slset-intersection" (test-group "examples from srfi-1 document" @@ -88,13 +119,20 @@ '(a b c) (slset-intersection '(a b c)))) (test-group "more examples" (test "multiple lists" - '(a a) (slset-intersection '(a x b y b a) '(x a x z) '(a b))))) + '(a a) (slset-intersection '(a x b y b a) '(x a x z) '(a b)))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b c d e i o u x y z))))) (test-group "slset-deduplicate (as per srfi-1's delete-duplicates)" (test-group "example from srfi-1 document" (test '(a b c z) (slset-deduplicate '(a b a c a b c z)))) (test-group "more examples" - (test '() (slset-deduplicate '()))))) + (test '() (slset-deduplicate '()))) + (test-group "all symbols used here still clean" + (test-assert (clean? '(a b c z))))) + + (test-group "finally, all symbols used in any test are still clean" + (test-assert (clean? all-symbols)))) (test-exit) |