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