source: trunk/source/tests/ansi-tests/set-exclusive-or.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 8.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 07:45:46 2003
4;;;; Contains: Tests of SET-EXCLUSIVE-OR
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest set-exclusive-or.1
11  (set-exclusive-or nil nil)
12  nil)
13
14(deftest set-exclusive-or.2
15  (let ((result
16         (set-exclusive-or-with-check '(a b c) nil)))
17    (check-set-exclusive-or '(a b c) nil result))
18  t)
19
20(deftest set-exclusive-or.3
21  (let ((result
22         (set-exclusive-or-with-check '(a b c d e f) '(f b d))))
23    (check-set-exclusive-or '(a b c d e f) '(f b d) result))
24  t)
25
26(deftest set-exclusive-or.4
27  (sort
28   (copy-list
29    (set-exclusive-or-with-check (shuffle '(1 2 3 4 5 6 7 8))
30                                 '(10 101 4 74 2 1391 7 17831)))
31   #'<)
32  (1 3 5 6 8 10 74 101 1391 17831))
33
34(deftest set-exclusive-or.5
35  (check-set-exclusive-or
36   nil
37   '(a b c d e f g h)
38   (set-exclusive-or-with-check nil '(a b c d e f g h)))
39  t)
40
41(deftest set-exclusive-or.6
42  (set-exclusive-or-with-check '(a b c d e) '(d a b e)
43                               :key nil)
44  (c))
45
46(deftest set-exclusive-or.7
47  (set-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eq)
48  (c))
49
50(deftest set-exclusive-or.7-a
51  (set-exclusive-or-with-check '(d a b e) '(a b c d e) :test #'eq)
52  (c))
53
54(deftest set-exclusive-or.8
55  (set-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eql)
56  (c))
57
58(deftest set-exclusive-or.8-a
59  (set-exclusive-or-with-check '(e d b a) '(a b c d e) :test #'eql)
60  (c))
61
62(deftest set-exclusive-or.8-b
63  (set-exclusive-or-with-check '(a b c d e) '(d a b e)
64                               :test-not (complement #'eql))
65  (c))
66
67(deftest set-exclusive-or.9
68  (set-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'equal)
69  (c))
70
71(deftest set-exclusive-or.10
72  (set-exclusive-or-with-check '(a b c d e) '(d a b e)
73                               :test 'eq)
74  (c))
75
76(deftest set-exclusive-or.11
77  (set-exclusive-or-with-check '(a b c d e) '(d a b e)
78                               :test 'eql)
79  (c))
80
81(deftest set-exclusive-or.12
82  (set-exclusive-or-with-check '(a b c d e) '(d a b e)
83                               :test 'equal)
84  (c))
85
86;;; (deftest set-exclusive-or.13
87;;;    (do-random-set-exclusive-ors 100 100)
88;;;  nil)
89
90(deftest set-exclusive-or.14
91  (set-exclusive-or-with-check '((a . 1) (b . 2) (c . 3012))
92                               '((a . 10) (c . 3))
93                               :key 'car)
94  ((b . 2)))
95
96(deftest set-exclusive-or.15
97  (set-exclusive-or-with-check '((a . xx) (b . 2) (c . 3))
98                               '((a . 1) (c . 3313))
99                               :key #'car)
100  ((b . 2)))
101
102(deftest set-exclusive-or.16
103  (set-exclusive-or-with-check '((a . xx) (b . 2) (c . 3))
104                               '((a . 1) (c . 3313))
105                               :key #'car
106                               :test-not (complement #'eql))
107  ((b . 2)))
108
109;;
110;; Check that set-exclusive-or does not invert
111;; the order of the arguments to the test function
112;;
113(deftest set-exclusive-or.17
114  (let ((list1 '(a b c d))
115        (list2 '(e f g h)))
116    (block fail
117      (notnot-mv
118       (set-exclusive-or-with-check
119        list1 list2
120        :test #'(lambda (s1 s2)
121                  (when (or (member s1 list2)
122                            (member s2 list1))
123                    (return-from fail 'failed)))))))
124  t)
125
126(deftest set-exclusive-or.17-a
127  (let ((list1 '(a b c d))
128        (list2 '(e f g h)))
129    (block fail
130      (notnot-mv
131       (set-exclusive-or-with-check
132        list1 list2
133        :key #'identity
134        :test #'(lambda (s1 s2)
135                  (when (or (member s1 list2)
136                            (member s2 list1))
137                    (return-from fail 'failed)))))))
138  t)
139
140(deftest set-exclusive-or.18
141  (let ((list1 '(a b c d))
142        (list2 '(e f g h)))
143    (block fail
144      (notnot-mv
145       (set-exclusive-or-with-check
146        list1 list2
147        :test-not
148        #'(lambda (s1 s2)
149            (when (or (member s1 list2)
150                      (member s2 list1))
151              (return-from fail 'failed))
152            t)))))
153  t)
154
155(deftest set-exclusive-or.18-a
156  (let ((list1 '(a b c d))
157        (list2 '(e f g h)))
158    (block fail
159      (notnot-mv
160       (set-exclusive-or-with-check
161        list1 list2
162        :key #'identity
163        :test-not
164        #'(lambda (s1 s2)
165            (when (or (member s1 list2)
166                      (member s2 list1))
167              (return-from fail 'failed))
168            t)))))
169  t)
170
171(defharmless set-exclusive-or.test-and-test-not.1
172  (set-exclusive-or (list 1 2 3 4) (list 1 7 3 8)
173                     :test #'eql :test-not #'eql))
174
175(defharmless set-exclusive-or.test-and-test-not.2
176  (set-exclusive-or (list 1 2 3 4) (list 1 7 3 8)
177                     :test-not #'eql :test #'eql))
178
179
180;;; Order of argument evaluation tests
181
182(deftest set-exclusive-or.order.1
183  (let ((i 0) x y)
184    (values
185     (sort
186      (set-exclusive-or (progn (setf x (incf i))
187                               (list 1 2 3 4))
188                        (progn (setf y (incf i))
189                               (list 1 3 6 10)))
190      #'<)
191     i x y))
192  (2 4 6 10) 2 1 2)
193
194(deftest set-exclusive-or.order.2
195  (let ((i 0) x y z)
196    (values
197     (sort
198      (set-exclusive-or (progn (setf x (incf i))
199                               (list 1 2 3 4))
200                        (progn (setf y (incf i))
201                               (list 1 3 6 10))
202                        :test (progn (setf z (incf i))
203                                     #'eql))
204      #'<)
205     i x y z))
206  (2 4 6 10) 3 1 2 3)
207
208(deftest set-exclusive-or.order.3
209  (let ((i 0) x y z w)
210    (values
211     (sort
212      (set-exclusive-or (progn (setf x (incf i))
213                               (list 1 2 3 4))
214                        (progn (setf y (incf i))
215                               (list 1 3 6 10))
216                        :test (progn (setf z (incf i))
217                                     #'eql)
218                        :key (progn (setf w (incf i)) nil))
219      #'<)
220     i x y z w))
221  (2 4 6 10) 4 1 2 3 4)
222
223(deftest set-exclusive-or.order.4
224  (let ((i 0) x y z w)
225    (values
226     (sort
227      (set-exclusive-or (progn (setf x (incf i))
228                               (list 1 2 3 4))
229                        (progn (setf y (incf i))
230                               (list 1 3 6 10))
231                        :key (progn (setf z (incf i)) nil)
232                        :test (progn (setf w (incf i))
233                                     #'eql))
234      #'<)
235     i x y z w))
236  (2 4 6 10) 4 1 2 3 4)
237
238(deftest set-exclusive-or.order.5
239  (let ((i 0) x y z w)
240    (values
241     (sort
242      (set-exclusive-or (progn (setf x (incf i))
243                               (list 1 2 3 4))
244                        (progn (setf y (incf i))
245                               (list 1 3 6 10))
246                        :key (progn (setf z (incf i)) nil)
247                        :key (progn (setf w (incf i))
248                                    (complement #'eql)))
249      #'<)
250     i x y z w))
251  (2 4 6 10) 4 1 2 3 4)
252
253
254;;; Keyword tests
255
256(deftest set-exclusive.allow-other-keys.1
257  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
258                          :bad t :allow-other-keys t)
259        #'<)
260  (1 2 5 6))
261
262(deftest set-exclusive.allow-other-keys.2
263  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
264                          :allow-other-keys t :bad t)
265        #'<)
266  (1 2 5 6))
267
268(deftest set-exclusive.allow-other-keys.3
269  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
270                          :allow-other-keys t :bad t
271                          :test #'(lambda (x y) (= x (1- y))))
272        #'<)
273  (1 6))
274
275(deftest set-exclusive.allow-other-keys.4
276  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
277                          :allow-other-keys t)
278        #'<)
279  (1 2 5 6))
280
281(deftest set-exclusive.allow-other-keys.5
282  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
283                          :allow-other-keys nil)
284        #'<)
285  (1 2 5 6))
286
287(deftest set-exclusive.allow-other-keys.6
288  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
289                          :allow-other-keys t
290                          :allow-other-keys nil)
291        #'<)
292  (1 2 5 6))
293
294(deftest set-exclusive.allow-other-keys.7
295  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
296                          :allow-other-keys t
297                          :allow-other-keys nil
298                          '#:x 1)
299        #'<)
300  (1 2 5 6))
301
302(deftest set-exclusive.keywords.8
303  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
304                          :test #'eql
305                          :test #'/=)
306        #'<)
307  (1 2 5 6))
308
309(deftest set-exclusive.keywords.9
310  (sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
311                          :test #'/=
312                          :test #'eql)
313        #'<)
314  nil)
315
316(def-fold-test set-exclusive-or.fold.1 (set-exclusive-or '(a b c d e f) '(b x e y z c)))
317
318;;; Error tests
319
320(deftest set-exclusive-or.error.1
321  (signals-error (set-exclusive-or) program-error)
322  t)
323
324(deftest set-exclusive-or.error.2
325  (signals-error (set-exclusive-or nil) program-error)
326  t)
327
328(deftest set-exclusive-or.error.3
329  (signals-error (set-exclusive-or nil nil :bad t) program-error)
330  t)
331
332(deftest set-exclusive-or.error.4
333  (signals-error (set-exclusive-or nil nil :key) program-error)
334  t)
335
336(deftest set-exclusive-or.error.5
337  (signals-error (set-exclusive-or nil nil 1 2) program-error)
338  t)
339
340(deftest set-exclusive-or.error.6
341  (signals-error (set-exclusive-or nil nil :bad t :allow-other-keys nil) program-error)
342  t)
343
344(deftest set-exclusive-or.error.7
345  (signals-error (set-exclusive-or (list 1 2) (list 3 4) :test #'identity) program-error)
346  t)
347
348(deftest set-exclusive-or.error.8
349  (signals-error (set-exclusive-or (list 1 2) (list 3 4) :test-not #'identity) program-error)
350  t)
351
352(deftest set-exclusive-or.error.9
353  (signals-error (set-exclusive-or (list 1 2) (list 3 4) :key #'cons) program-error)
354  t)
355
356(deftest set-exclusive-or.error.10
357  (signals-error (set-exclusive-or (list 1 2) (list 3 4) :key #'car) type-error)
358  t)
359
360(deftest set-exclusive-or.error.11
361  (signals-error (set-exclusive-or (list 1 2 3) (list* 4 5 6)) type-error)
362  t)
363
364(deftest set-exclusive-or.error.12
365  (signals-error (set-exclusive-or (list* 1 2 3) (list 4 5 6)) type-error)
366  t)
367
368(deftest set-exclusive-or.error.13
369  (check-type-error #'(lambda (x) (set-exclusive-or x '(a b c))) #'listp)
370  nil)
371
372(deftest set-exclusive-or.error.14
373  (check-type-error #'(lambda (x) (set-exclusive-or '(a b c) x)) #'listp)
374  nil)
375
376
377;;; Randomized test
378
379(deftest random-set-exclusive-or
380  (random-set-exclusive-or-test 10 100)
381  nil)
382
Note: See TracBrowser for help on using the repository browser.