10 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
11 |
;;; union |
;;; union |
12 |
|
|
13 |
(deftest union-1 |
(deftest union.1 |
14 |
(union nil nil) |
(union nil nil) |
15 |
nil) |
nil) |
16 |
|
|
17 |
(deftest union-2 |
(deftest union.2 |
18 |
(union-with-check (list 'a) nil) |
(union-with-check (list 'a) nil) |
19 |
(a)) |
(a)) |
20 |
|
|
21 |
(deftest union-3 |
(deftest union.3 |
22 |
(union-with-check (list 'a) (list 'a)) |
(union-with-check (list 'a) (list 'a)) |
23 |
(a)) |
(a)) |
24 |
|
|
25 |
(deftest union-4 |
(deftest union-4 |
26 |
(union-with-check (list 1) (list 1)) |
(union-with-check (list 1) (list 1)) |
27 |
(1)) |
(1)) |
28 |
|
|
29 |
(deftest union-5 |
(deftest union.5 |
30 |
(let ((x (list 'a 'b))) |
(let ((x (list 'a 'b))) |
31 |
(union-with-check (list x) (list x))) |
(union-with-check (list x) (list x))) |
32 |
((a b))) |
((a b))) |
33 |
|
|
34 |
(deftest union-6 |
(deftest union.6 |
35 |
(let ((x (copy-list '(a b c d e f))) |
(let ((x (copy-list '(a b c d e f))) |
36 |
(y (copy-list '(z c y a v b)))) |
(y (copy-list '(z c y a v b)))) |
37 |
(let ((result (union-with-check x y))) |
(let ((result (union-with-check x y))) |
38 |
(check-union x y result))) |
(check-union x y result))) |
39 |
t) |
t) |
40 |
|
|
41 |
(deftest union-6-a |
(deftest union.6-a |
42 |
(let ((x (copy-list '(a b c d e f))) |
(let ((x (copy-list '(a b c d e f))) |
43 |
(y (copy-list '(z c y a v b)))) |
(y (copy-list '(z c y a v b)))) |
44 |
(let ((result (union-with-check x y :test #'eq))) |
(let ((result (union-with-check x y :test #'eq))) |
45 |
(check-union x y result))) |
(check-union x y result))) |
46 |
t) |
t) |
47 |
|
|
48 |
(deftest union-7 |
(deftest union.7 |
49 |
(let ((x (copy-list '(a b c d e f))) |
(let ((x (copy-list '(a b c d e f))) |
50 |
(y (copy-list '(z c y a v b)))) |
(y (copy-list '(z c y a v b)))) |
51 |
(let ((result (union-with-check x y :test #'eql))) |
(let ((result (union-with-check x y :test #'eql))) |
52 |
(check-union x y result))) |
(check-union x y result))) |
53 |
t) |
t) |
54 |
|
|
55 |
(deftest union-8 |
(deftest union.8 |
56 |
(let ((x (copy-list '(a b c d e f))) |
(let ((x (copy-list '(a b c d e f))) |
57 |
(y (copy-list '(z c y a v b)))) |
(y (copy-list '(z c y a v b)))) |
58 |
(let ((result (union-with-check x y :test #'equal))) |
(let ((result (union-with-check x y :test #'equal))) |
59 |
(check-union x y result))) |
(check-union x y result))) |
60 |
t) |
t) |
61 |
|
|
62 |
(deftest union-9 |
(deftest union.9 |
63 |
(let ((x (copy-list '(a b c d e f))) |
(let ((x (copy-list '(a b c d e f))) |
64 |
(y (copy-list '(z c y a v b)))) |
(y (copy-list '(z c y a v b)))) |
65 |
(let ((result (union-with-check x y :test-not (complement #'eql)))) |
(let ((result (union-with-check x y :test-not (complement #'eql)))) |
66 |
(check-union x y result))) |
(check-union x y result))) |
67 |
t) |
t) |
68 |
|
|
69 |
(deftest union-10 |
(deftest union.10 |
70 |
(let ((x (copy-list '(a b c d e f))) |
(let ((x (copy-list '(a b c d e f))) |
71 |
(y (copy-list '(z c y a v b)))) |
(y (copy-list '(z c y a v b)))) |
72 |
(let ((result (union-with-check x y :test-not (complement #'equal)))) |
(let ((result (union-with-check x y :test-not (complement #'equal)))) |
73 |
(check-union x y result))) |
(check-union x y result))) |
74 |
t) |
t) |
75 |
|
|
76 |
(deftest union-11 |
(deftest union.11 |
77 |
(let ((x (copy-list '(a b c d e f))) |
(let ((x (copy-list '(a b c d e f))) |
78 |
(y (copy-list '(z c y a v b)))) |
(y (copy-list '(z c y a v b)))) |
79 |
(let ((result (union-with-check x y :test-not (complement #'eq)))) |
(let ((result (union-with-check x y :test-not (complement #'eq)))) |
80 |
(check-union x y result))) |
(check-union x y result))) |
81 |
t) |
t) |
82 |
|
|
83 |
(deftest union-12 |
(deftest union.12 |
84 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
85 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
86 |
(let ((result (union-with-check x y))) |
(let ((result (union-with-check x y))) |
87 |
(check-union x y result))) |
(check-union x y result))) |
88 |
t) |
t) |
89 |
|
|
90 |
(deftest union-13 |
(deftest union.13 |
91 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
92 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
93 |
(let ((result (union-with-check x y :test #'equal))) |
(let ((result (union-with-check x y :test #'equal))) |
94 |
(check-union x y result))) |
(check-union x y result))) |
95 |
t) |
t) |
96 |
|
|
97 |
(deftest union-14 |
(deftest union.14 |
98 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
99 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
100 |
(let ((result (union-with-check x y :test #'eql))) |
(let ((result (union-with-check x y :test #'eql))) |
101 |
(check-union x y result))) |
(check-union x y result))) |
102 |
t) |
t) |
103 |
|
|
104 |
(deftest union-15 |
(deftest union.15 |
105 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
106 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
107 |
(let ((result (union-with-check x y :test-not (complement #'equal)))) |
(let ((result (union-with-check x y :test-not (complement #'equal)))) |
108 |
(check-union x y result))) |
(check-union x y result))) |
109 |
t) |
t) |
110 |
|
|
111 |
(deftest union-16 |
(deftest union.16 |
112 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
113 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
114 |
(let ((result (union-with-check x y :test-not (complement #'eql)))) |
(let ((result (union-with-check x y :test-not (complement #'eql)))) |
115 |
(check-union x y result))) |
(check-union x y result))) |
116 |
t) |
t) |
117 |
|
|
118 |
(deftest union-17 |
(deftest union.17 |
119 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
120 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
121 |
(let ((result (union-with-check-and-key x y #'1+))) |
(let ((result (union-with-check-and-key x y #'1+))) |
122 |
(check-union x y result))) |
(check-union x y result))) |
123 |
t) |
t) |
124 |
|
|
125 |
(deftest union-18 |
(deftest union.18 |
126 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
127 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
128 |
(let ((result (union-with-check-and-key x y #'1+ :test #'equal))) |
(let ((result (union-with-check-and-key x y #'1+ :test #'equal))) |
129 |
(check-union x y result))) |
(check-union x y result))) |
130 |
t) |
t) |
131 |
|
|
132 |
(deftest union-19 |
(deftest union.19 |
133 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
134 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
135 |
(let ((result (union-with-check-and-key x y #'1+ :test #'eql))) |
(let ((result (union-with-check-and-key x y #'1+ :test #'eql))) |
136 |
(check-union x y result))) |
(check-union x y result))) |
137 |
t) |
t) |
138 |
|
|
139 |
(deftest union-20 |
(deftest union.20 |
140 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
141 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
142 |
(let ((result (union-with-check-and-key x y #'1+ |
(let ((result (union-with-check-and-key x y #'1+ |
143 |
:test-not (complement #'equal)))) |
:test-not (complement #'equal)))) |
144 |
(check-union x y result))) |
(check-union x y result))) |
145 |
t) |
t) |
146 |
|
|
147 |
(deftest union-21 |
(deftest union.21 |
148 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
149 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
150 |
(let ((result (union-with-check-and-key x y #'1+ |
(let ((result (union-with-check-and-key x y #'1+ |
151 |
:test-not (complement #'equal)))) |
:test-not (complement #'equal)))) |
152 |
(check-union x y result))) |
(check-union x y result))) |
153 |
t) |
t) |
154 |
|
|
155 |
(deftest union-22 |
(deftest union.22 |
156 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
157 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
158 |
(let ((result (union-with-check-and-key x y nil))) |
(let ((result (union-with-check-and-key x y nil))) |
159 |
(check-union x y result))) |
(check-union x y result))) |
160 |
t) |
t) |
161 |
|
|
162 |
(deftest union-23 |
(deftest union.23 |
163 |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
(let ((x (copy-list '(1 2 3 4 5 6 7))) |
164 |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
(y (copy-list '(10 19 5 3 17 1001 2)))) |
165 |
(let ((result (union-with-check-and-key x y '1+))) |
(let ((result (union-with-check-and-key x y '1+))) |
168 |
|
|
169 |
;; Do large numbers of random units |
;; Do large numbers of random units |
170 |
|
|
171 |
(deftest union-24 |
(deftest union.24 |
172 |
(do-random-unions 100 100 200) |
(do-random-unions 100 100 200) |
173 |
nil) |
nil) |
174 |
|
|
175 |
(deftest union-25 |
(deftest union.25 |
176 |
(let ((x (shuffle '(1 4 6 10 45 101))) |
(let ((x (shuffle '(1 4 6 10 45 101))) |
177 |
(y (copy-list '(102 5 2 11 44 6)))) |
(y (copy-list '(102 5 2 11 44 6)))) |
178 |
(let ((result (union-with-check x y |
(let ((result (union-with-check x y |
189 |
|
|
190 |
;;; Check that union uses eql, not equal or eq |
;;; Check that union uses eql, not equal or eq |
191 |
|
|
192 |
(deftest union-26 |
(deftest union.26 |
193 |
(let ((x 1000) |
(let ((x 1000) |
194 |
(y 1000)) |
(y 1000)) |
195 |
(loop |
(loop |
206 |
1)))) |
1)))) |
207 |
t) |
t) |
208 |
|
|
209 |
(deftest union-27 |
(deftest union.27 |
210 |
(union-with-check (list (copy-seq "aa")) |
(union-with-check (list (copy-seq "aa")) |
211 |
(list (copy-seq "aa"))) |
(list (copy-seq "aa"))) |
212 |
("aa" "aa")) |
("aa" "aa")) |
213 |
|
|
214 |
;; Check that union does not reverse the arguments to :test, :test-not |
;; Check that union does not reverse the arguments to :test, :test-not |
215 |
|
|
216 |
(deftest union-28 |
(deftest union.28 |
217 |
(block fail |
(block fail |
218 |
(sort |
(sort |
219 |
(union-with-check |
(union-with-check |
220 |
(list 1 2 3) |
(list 1 2 3) |
221 |
(list 4 5 6) |
(list 4 5 6) |
222 |
:test #'(lambda (x y) |
:test #'(lambda (x y) |
223 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
224 |
(eql x y))) |
(eql x y))) |
225 |
#'<)) |
#'<)) |
226 |
(1 2 3 4 5 6)) |
(1 2 3 4 5 6)) |
227 |
|
|
228 |
(deftest union-29 |
(deftest union.29 |
229 |
(block fail |
(block fail |
230 |
(sort |
(sort |
231 |
(union-with-check-and-key |
(union-with-check-and-key |
232 |
(list 1 2 3) |
(list 1 2 3) |
233 |
(list 4 5 6) |
(list 4 5 6) |
234 |
#'identity |
#'identity |
235 |
:test #'(lambda (x y) |
:test #'(lambda (x y) |
236 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
237 |
(eql x y))) |
(eql x y))) |
238 |
#'<)) |
#'<)) |
239 |
(1 2 3 4 5 6)) |
(1 2 3 4 5 6)) |
240 |
|
|
241 |
(deftest union-30 |
(deftest union.30 |
242 |
(block fail |
(block fail |
243 |
(sort |
(sort |
244 |
(union-with-check |
(union-with-check |
245 |
(list 1 2 3) |
(list 1 2 3) |
246 |
(list 4 5 6) |
(list 4 5 6) |
247 |
:test-not |
:test-not |
248 |
#'(lambda (x y) |
#'(lambda (x y) |
249 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
250 |
(not (eql x y)))) |
(not (eql x y)))) |
251 |
#'<)) |
#'<)) |
252 |
(1 2 3 4 5 6)) |
(1 2 3 4 5 6)) |
253 |
|
|
254 |
(deftest union-31 |
(deftest union.31 |
255 |
(block fail |
(block fail |
256 |
(sort |
(sort |
257 |
(union-with-check-and-key |
(union-with-check-and-key |
258 |
(list 1 2 3) |
(list 1 2 3) |
259 |
(list 4 5 6) |
(list 4 5 6) |
260 |
#'identity |
#'identity |
261 |
:test-not #'(lambda (x y) |
:test-not #'(lambda (x y) |
262 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
263 |
(not (eql x y)))) |
(not (eql x y)))) |
264 |
#'<)) |
#'<)) |
265 |
(1 2 3 4 5 6)) |
(1 2 3 4 5 6)) |
266 |
|
|
267 |
|
;;; Order of evaluation tests |
268 |
|
|
269 |
|
(deftest union.32 |
270 |
|
(let ((i 0) x y) |
271 |
|
(values |
272 |
|
(sort |
273 |
|
(union (progn (setf x (incf i)) (copy-list '(1 3 5))) |
274 |
|
(progn (setf y (incf i)) (copy-list '(2 5 8)))) |
275 |
|
#'<) |
276 |
|
i x y)) |
277 |
|
(1 2 3 5 8) |
278 |
|
2 1 2) |
279 |
|
|
280 |
|
(deftest union.33 |
281 |
|
(let ((i 0) x y z w) |
282 |
|
(values |
283 |
|
(sort |
284 |
|
(union (progn (setf x (incf i)) (copy-list '(1 3 5))) |
285 |
|
(progn (setf y (incf i)) (copy-list '(2 5 8))) |
286 |
|
:test (progn (setf z (incf i)) #'eql) |
287 |
|
:key (progn (setf w (incf i)) #'identity)) |
288 |
|
#'<) |
289 |
|
i x y z w)) |
290 |
|
(1 2 3 5 8) |
291 |
|
4 1 2 3 4) |
292 |
|
|
293 |
|
|
294 |
|
(deftest union.34 |
295 |
|
(let ((i 0) x y z w) |
296 |
|
(values |
297 |
|
(sort |
298 |
|
(union (progn (setf x (incf i)) (copy-list '(1 3 5))) |
299 |
|
(progn (setf y (incf i)) (copy-list '(2 5 8))) |
300 |
|
:key (progn (setf z (incf i)) #'identity) |
301 |
|
:test (progn (setf w (incf i)) #'eql)) |
302 |
|
#'<) |
303 |
|
i x y z w)) |
304 |
|
(1 2 3 5 8) |
305 |
|
4 1 2 3 4) |
306 |
|
|
307 |
;;; Keyword tests |
;;; Keyword tests |
308 |
|
|
309 |
(deftest union.allow-other-keys.1 |
(deftest union.allow-other-keys.1 |