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