← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/intersection.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/intersection.lsp
 
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
;;; Error tests
 
353
 
 
354
(deftest intersection.error.1
 
355
  (signals-error (intersection) program-error)
 
356
  t)
 
357
 
 
358
(deftest intersection.error.2
 
359
  (signals-error (intersection nil) program-error)
 
360
  t)
 
361
 
 
362
(deftest intersection.error.3
 
363
  (signals-error (intersection nil nil :bad t) program-error)
 
364
  t)
 
365
 
 
366
(deftest intersection.error.4
 
367
  (signals-error (intersection nil nil :key) program-error)
 
368
  t)
 
369
 
 
370
(deftest intersection.error.5
 
371
  (signals-error (intersection nil nil 1 2) program-error)
 
372
  t)
 
373
 
 
374
(deftest intersection.error.6
 
375
  (signals-error (intersection nil nil :bad t :allow-other-keys nil)
 
376
                 program-error)
 
377
  t)
 
378
 
 
379
(deftest intersection.error.7
 
380
  (signals-error (intersection '(a b c) '(d e f) :test #'identity)
 
381
                 program-error)
 
382
  t)
 
383
 
 
384
(deftest intersection.error.8
 
385
  (signals-error (intersection '(a b c) '(d e f) :test-not #'identity)
 
386
                 program-error)
 
387
  t)
 
388
 
 
389
(deftest intersection.error.9
 
390
  (signals-error (intersection '(a b c) '(d e f) :key #'cons)
 
391
                 program-error)
 
392
  t)
 
393
 
 
394
(deftest intersection.error.10
 
395
  (signals-error (intersection '(a b c) '(d e f) :key #'car)
 
396
                 type-error)
 
397
  t)
 
398
 
 
399
(deftest intersection.error.11
 
400
  (signals-error (intersection '(a b c) '(d e f . g))
 
401
                 type-error)
 
402
  t)
 
403
 
 
404
(deftest intersection.error.12
 
405
  (signals-error (intersection '(a b . c) '(d e f))
 
406
                 type-error)
 
407
  t)