blob: 06f4f2ca92e42d7e533738a1a64f1e39747dcb51 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
;; (load "../slsets.scm")
(import slsets test)
(test-group "slsets"
(test-group "slset<="
(test-group "examples from srfi-1 document"
(test-assert (slset<= '(a) '(a b a) '(a b c c)))
(test-assert "trivial case no args" (slset<=))
(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-group "slset="
(test-group "examples from srfi-1 document"
(test-assert (slset= '(b e a) '(a e b) '(e e b a)))
(test-assert "trivial case no args" (slset=))
(test-assert "trivial case one arg" (slset= '(a))))
(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-group "slset-adjoin"
(test-group "example from srfi-1 document"
(test '(u o i a b c d c e)
(slset-adjoin '(a b c d c e) 'a 'e 'i 'o 'u)))
;; Spec says it should, so check it
(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-group "slset-union"
(test-group "examples from srfi-1 document"
(test '(u o i a b c d e) (slset-union '(a b c d e) '(a e i o u)))
(test "Repeated elements in LIST1 are preserved"
'(x a a c)
(slset-union '(a a c) '(x a x)))
(test "trivial case no args"
'()
(slset-union))
(test "trivial case one arg"
'(a b c)
(slset-union '(a b c)))))
(test-group "slset-xor"
(test-group "examples from srfi-1 document"
;;(test '(d c b i o u) (slset-xor '(a b c d e) '(a e i o u)))
;; NOTE: The above has a peculiar ordering, but there's nothing
;; in the spec guaranteeing it should be like that. We return this:
(test '(b c d i o u) (slset-xor '(a b c d e) '(a e i o u)))
(test "trivial case no args"
'() (slset-xor))
(test "trivial case one arg"
'(a b c d e) (slset-xor '(a b c d e))))
(test-group "extra examples"
(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)))))
(test-group "slset-difference"
(test-group "examples from srfi-1 document"
(test '(b c d) (slset-difference '(a b c d e) '(a e i o u)))
(test "trivial case"
'(a b c) (slset-difference '(a b c))))
(test-group "more examples"
(test "duplicates in first list are preserved"
'(b b c d)
(slset-difference '(a b b c x x d x i e) '(a e i o u) '() '(x x y z z)))
(test "empty list returns same list"
'(a b b c d e)
(slset-difference '(a b b c d e) '()))
(test "empty list is empty"
'()
(slset-difference '() '(a b b c d e)))
(test "empty list is still empty after other args"
'()
(slset-difference '() '(a b) '(c d e) '()))))
(test-group "slset-intersection"
(test-group "examples from srfi-1 document"
(test '(a e) (slset-intersection '(a b c d e) '(a e i o u)))
(test "repeated elements in LIST1 are preserved"
'(a x a) (slset-intersection '(a x y a) '(x a x z)))
(test "trivial case"
'(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)))))
(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-exit)
|
