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