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

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

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

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