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