intersection.lsp 10.7 KB
Newer Older
1 2
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
3 4
;;;; Created:  Sun Apr 20 07:39:19 2003
;;;; Contains: Tests of INTERSECTION
5 6

(in-package :cl-test)
7

8 9
(compile-and-load "cons-aux.lsp")

10 11
(deftest intersection.1
  (intersection nil nil)
12 13
  nil)

14 15
(deftest intersection.2
  (intersection (loop for i from 1 to 100 collect i) nil)
16 17
  nil)

18 19
(deftest intersection.3
  (intersection nil (loop for i from 1 to 100 collect i))
20 21
  nil)

22 23
(deftest intersection.4
  (let* ((x (copy-list '(a 1 c 7 b 4 3 z)))
sds's avatar
sds committed
24 25 26 27
         (xcopy (make-scaffold-copy x))
         (y (copy-list '(3 y c q z a 18)))
         (ycopy (make-scaffold-copy y))
         (result (intersection x y)))
28 29 30 31 32 33 34
    (and
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     (+
      (loop
       for e in x count
       (and (member e y)
sds's avatar
sds committed
35
            (not (member e result))))
36 37 38
      (loop
       for e in result count
       (or (not (member e x))
sds's avatar
sds committed
39
           (not (member e y))))
40 41 42
      (loop
       for hd on result count
       (and (consp hd)
sds's avatar
sds committed
43
            (member (car hd) (cdr hd)))))))
44 45
  0)

46 47
(deftest intersection.5
  (let* ((x (copy-list '(a a a)))
sds's avatar
sds committed
48 49 50 51
         (xcopy (make-scaffold-copy x))
         (y (copy-list '(a a a b b b)))
         (ycopy (make-scaffold-copy y))
         (result (intersection x y)))
52 53 54 55 56
    (and
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     (member 'a result)
     (not (member 'b result))))
57 58
  t)

59 60
(deftest intersection.6
  (intersection (list 1000000000000 'a 'b 'c)
sds's avatar
sds committed
61
                (list (1+ 999999999999) 'd 'e 'f))
62 63
  (1000000000000))

64 65
(deftest intersection.7
  (intersection (list 'a 10 'b 17)
sds's avatar
sds committed
66
                (list 'c 'd 4 'e 'f 10 1 13 'z))
67 68
  (10))

69 70
(deftest intersection.8
  (intersection (list 'a (copy-seq "aaa") 'b)
sds's avatar
sds committed
71
                (list 'd (copy-seq "aaa") 'e))
72 73
  nil)

74 75
(deftest intersection.9
  (intersection (list 'a (copy-seq "aaa") 'b)
sds's avatar
sds committed
76 77
                (list 'd (copy-seq "aaa") 'e)
                :test #'equal)
78 79 80
  ("aaa"))

;; Same as 9, but with a symbol function designator for :test
81 82
(deftest intersection.9-a
  (intersection (list 'a (copy-seq "aaa") 'b)
sds's avatar
sds committed
83 84
                (list 'd (copy-seq "aaa") 'e)
                :test 'equal)
85 86
  ("aaa"))

87 88
(deftest intersection.9-b
  (intersection (list 'a (copy-seq "aaa") 'b)
sds's avatar
sds committed
89 90
                (list 'd (copy-seq "aaa") 'e)
                :test-not #'(lambda (p q) (not (equal p q))))
91 92
  ("aaa"))

93
(deftest intersection.10
94 95 96
  (equalt
   (sort
    (intersection (loop
sds's avatar
sds committed
97 98 99 100 101
                   for i from 0 to 1000 by 3
                   collect i)
                  (loop
                   for i from 0 to 1000 by 7
                   collect i))
102 103
    #'<)
   (loop for i from 0 to 1000 by 21 collect i))
104 105
  t)

106
(deftest intersection.11
107 108 109
  (equalt
   (sort
    (intersection (loop
sds's avatar
sds committed
110 111 112 113 114 115 116 117
                   for i from 0 to 999 by 5
                   collect i)
                  (loop
                   for i from 0 to 999 by 7
                   collect i)
                  :test #'(lambda (a b)
                            (and (eql a b)
                                 (= (mod a 3) 0))))
118 119
    #'<)
   (loop for i from 0 to 999 by (* 3 5 7) collect i))
120 121
  t)

122
(deftest intersection.11-a
123 124 125
  (equalt
   (sort
    (intersection (loop
sds's avatar
sds committed
126 127 128 129 130 131 132 133 134
                   for i from 0 to 999 by 5
                   collect i)
                  (loop
                   for i from 0 to 999 by 7
                   collect i)
                  :test-not
                  #'(lambda (a b)
                      (not (and (eql a b)
                                (= (mod a 3) 0)))))
135 136
    #'<)
   (loop for i from 0 to 999 by (* 3 5 7) collect i))
137 138 139 140 141 142
  t)

;;
;; Do large numbers of random intersection tests
;;

143 144
(deftest intersection.12
  (intersection-12-body 100 100)
145 146 147 148 149 150 151
  nil)


;;
;; :key argument
;;

152
(deftest intersection.13
153
  (let ((x (copy-list '(0 5 8 13 31 42)))
sds's avatar
sds committed
154
        (y (copy-list '(3 5 42 0 7 100 312 33))))
155 156 157
    (equalt
     (sort (copy-list (intersection x y)) #'<)
     (sort (copy-list (intersection x y :key #'1+)) #'<)))
158 159 160
  t)

;; 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)))
sds's avatar
sds committed
163
        (y (copy-list '(3 5 42 0 7 100 312 33))))
164 165 166
    (equalt
     (sort (copy-list (intersection x y)) #'<)
     (sort (copy-list (intersection x y :key '1+)) #'<)))
167 168 169 170
  t)

;; Test that a nil key argument is ignored

171
(deftest intersection.14
172 173
  (let
      ((result (intersection (copy-list '(a b c d))
sds's avatar
sds committed
174 175
                             (copy-list '(e c f b g))
                             :key nil)))
176 177 178 179 180
    (and
     (member 'b result)
     (member 'c result)
     (every #'(lambda (x) (member x '(b c))) result)
     t))
181 182 183 184
  t)

;; Test that intersection preserves the order of arguments to :test, :test-not

185
(deftest intersection.15
186
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
187
        (list2 (list 4 5 6 7)))
188 189 190 191 192
    (block fail
      (intersection
       list1 list2
       :test
       #'(lambda (x y)
sds's avatar
sds committed
193 194
           (when (< y x) (return-from fail 'fail))
           (eql x y)))))
195 196
  (4))

197
(deftest intersection.16
198
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
199
        (list2 (list 4 5 6 7)))
200 201 202 203 204 205
    (block fail
      (intersection
       list1 list2
       :key #'identity
       :test
       #'(lambda (x y)
sds's avatar
sds committed
206 207
           (when (< y x) (return-from fail 'fail))
           (eql x y)))))
208 209
  (4))

210
(deftest intersection.17
211
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
212
        (list2 (list 4 5 6 7)))
213 214 215 216 217
    (block fail
      (intersection
       list1 list2
       :test-not
       #'(lambda (x y)
sds's avatar
sds committed
218 219
           (when (< y x) (return-from fail 'fail))
           (not (eql x y))))))
220 221
  (4))

222
(deftest intersection.18
223
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
224
        (list2 (list 4 5 6 7)))
225 226 227 228 229 230
    (block fail
      (intersection
       list1 list2
       :key #'identity
       :test-not
       #'(lambda (x y)
sds's avatar
sds committed
231 232
           (when (< y x) (return-from fail 'fail))
           (not (eql x y))))))
233 234
  (4))

235 236 237 238 239 240
(defharmless intersection.test-and-test-not.1
  (intersection '(a b c) '(a c e) :test #'eql :test-not #'eql))

(defharmless intersection.test-and-test-not.2
  (intersection '(a b c) '(a c e) :test-not #'eql :test #'eql))

241 242
;;; Order of argument evaluation tests

243
(deftest intersection.order.1
244 245 246
  (let ((i 0) x y)
    (values
     (intersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
247
                   (progn (setf y (incf i)) (list 'c 'd)))
248 249 250
     i x y))
  nil 2 1 2)

251
(deftest intersection.order.2
252 253 254
  (let ((i 0) x y)
    (values
     (intersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
255 256
                   (progn (setf y (incf i)) (list 'c 'd))
                   :test #'eq)
257 258 259
     i x y))
  nil 2 1 2)

260
(deftest intersection.order.3
261 262 263
  (let ((i 0) x y z w)
    (values
     (intersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
264 265 266 267
                   (progn (setf y (incf i)) (list 'c 'd))
                   :test (progn (setf z (incf i)) #'eq)
                   :test (progn (setf w (incf i))
                                (complement #'eq)))
268 269 270
     i x y z w))
  nil 4 1 2 3 4)

271
(deftest intersection.order.4
272 273 274
  (let ((i 0) x y z w)
    (values
     (intersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
275 276 277
                   (progn (setf y (incf i)) (list 'c 'd))
                   :test (progn (setf z (incf i)) #'eq)
                   :key (progn (setf w (incf i)) #'identity))
278 279 280
     i x y z w))
  nil 4 1 2 3 4)

281
(deftest intersection.order.5
282 283 284
  (let ((i 0) x y z w)
    (values
     (intersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
285 286 287
                   (progn (setf y (incf i)) (list 'c 'd))
                   :key (progn (setf z (incf i)) #'identity)
                   :test (progn (setf w (incf i)) #'eq))
288 289 290 291
     i x y z w))
  nil 4 1 2 3 4)


292 293 294
;;; Keyword tests

(deftest intersection.allow-other-keys.1
295
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
296
        (list2 (list 4 5 6 7)))
297 298 299
    (intersection list1 list2 :bad t :allow-other-keys 1))
  (4))

300
(deftest intersection.allow-other-keys.2
301
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
302
        (list2 (list 4 5 6 7)))
303 304 305
    (intersection list1 list2 :allow-other-keys :foo :also-bad t))
  (4))

306
(deftest intersectionallow-other-keys.3
307
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
308
        (list2 (list 4 5 6 7)))
309
    (intersection list1 list2 :allow-other-keys :foo :also-bad t
sds's avatar
sds committed
310
                  :test #'(lambda (x y) (= x (1+ y)))))
311 312
  nil)

313 314
(deftest intersection.allow-other-keys.4
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
315
        (list2 (list 4 5 6 7)))
316 317 318 319 320
    (intersection list1 list2 :allow-other-keys t))
  (4))

(deftest intersection.allow-other-keys.5
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
321
        (list2 (list 4 5 6 7)))
322 323 324 325 326
    (intersection list1 list2 :allow-other-keys nil))
  (4))

(deftest intersection.allow-other-keys.6
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
327
        (list2 (list 4 5 6 7)))
328
    (intersection list1 list2 :allow-other-keys t
sds's avatar
sds committed
329
                  :allow-other-keys nil :bad t))
330 331 332 333 334
  (4))

(deftest intersection.allow-other-keys.7
  (sort
   (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
335
         (list2 (list 4 5 6 7)))
336
     (intersection list1 list2 :allow-other-keys t
sds's avatar
sds committed
337 338
                   :allow-other-keys nil
                   :test #'(lambda (x y) (eql x (1- y)))))
339 340 341 342 343 344
   #'<)
  (3 4))

(deftest intersection.keywords.8
  (sort
   (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
345
         (list2 (list 4 5 6 7)))
346
     (intersection list1 list2
sds's avatar
sds committed
347 348
                   :test #'(lambda (x y) (eql x (1- y)))
                   :test #'eql))
349 350 351
   #'<)
  (3 4))

pfdietz's avatar
pfdietz committed
352 353
(def-fold-test intersection.fold.1 (intersection '(a b c d e f) '(d w a x b y)))

354 355
;;; Error tests

356
(deftest intersection.error.1
357 358
  (signals-error (intersection) program-error)
  t)
359 360

(deftest intersection.error.2
361 362
  (signals-error (intersection nil) program-error)
  t)
363 364

(deftest intersection.error.3
365 366
  (signals-error (intersection nil nil :bad t) program-error)
  t)
367 368

(deftest intersection.error.4
369 370
  (signals-error (intersection nil nil :key) program-error)
  t)
371 372

(deftest intersection.error.5
373 374
  (signals-error (intersection nil nil 1 2) program-error)
  t)
375 376

(deftest intersection.error.6
377
  (signals-error (intersection nil nil :bad t :allow-other-keys nil)
sds's avatar
sds committed
378
                 program-error)
379
  t)
380

381
(deftest intersection.error.7
382
  (signals-error (intersection '(a b c) '(d e f) :test #'identity)
sds's avatar
sds committed
383
                 program-error)
384
  t)
385 386

(deftest intersection.error.8
387
  (signals-error (intersection '(a b c) '(d e f) :test-not #'identity)
sds's avatar
sds committed
388
                 program-error)
389
  t)
390 391

(deftest intersection.error.9
392
  (signals-error (intersection '(a b c) '(d e f) :key #'cons)
sds's avatar
sds committed
393
                 program-error)
394
  t)
395 396

(deftest intersection.error.10
397
  (signals-error (intersection '(a b c) '(d e f) :key #'car)
sds's avatar
sds committed
398
                 type-error)
399
  t)
400

401
(deftest intersection.error.11
402
  (signals-error (intersection '(a b c) '(d e f . g))
sds's avatar
sds committed
403
                 type-error)
404
  t)
405 406

(deftest intersection.error.12
407
  (signals-error (intersection '(a b . c) '(d e f))
sds's avatar
sds committed
408
                 type-error)
409
  t)
pfdietz's avatar
pfdietz committed
410 411 412 413 414 415 416

(deftest intersection.error.13
  (check-type-error #'(lambda (x) (intersection x '(a b c))) #'listp)
  nil)

(deftest intersection.error.14
  (check-type-error #'(lambda (x) (intersection '(a b c) x)) #'listp)
sds's avatar
sds committed
417
  nil)