nintersection.lsp 9.8 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:40:02 2003
;;;; Contains: Tests of NINTERSECTION

Daniel Kochmański's avatar
Daniel Kochmański committed
6

7

8

9

10 11 12 13 14 15 16 17 18 19 20 21 22 23
(deftest nintersection.1
  (nintersection nil nil)
  nil)

(deftest nintersection.2
  (nintersection (loop for i from 1 to 100 collect i) nil)
  nil)

(deftest nintersection.3
  (nintersection-with-check nil (loop for i from 1 to 100 collect i))
  nil)

(deftest nintersection.4
  (let* ((x (copy-list '(a 1 c 7 b 4 3 z)))
sds's avatar
sds committed
24 25 26
         (xc (copy-list x))
         (y (copy-list '(3 y c q z a 18)))
         (result (nintersection-with-check xc y)))
27 28 29 30
    (and
     (not (eqt result 'failed))
     (+
      (loop for e in x count
sds's avatar
sds committed
31 32
            (and (member e y)
                 (not (member e result))))
33
      (loop for e in result count
sds's avatar
sds committed
34
            (or (not (member e x)) (not (member e y))))
35
      (loop for hd on result count
sds's avatar
sds committed
36 37
            (and (consp hd)
                 (member (car hd) (cdr hd)))))))
38 39 40 41
  0)

(deftest nintersection.5
  (let* ((x (copy-list '(a a a)))
sds's avatar
sds committed
42 43
         (y (copy-list '(a a a b b b)))
         (result (nintersection-with-check x y)))
44 45 46 47 48 49 50 51 52 53 54 55 56 57
    (and
     (not (eqt result 'failed))
     (member 'a result)
     (not (member 'b result))))
  t)

(deftest nintersection.6
  (nintersection-with-check
   (list 1000000000000 'a 'b 'c)
   (list (1+ 999999999999) 'd 'e 'f))
  (1000000000000))

(deftest nintersection.7
  (nintersection-with-check (list 'a 10 'b 17)
sds's avatar
sds committed
58
                            (list 'c 'd 4 'e 'f 10 1 13 'z))
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
  (10))

(deftest nintersection.8
  (nintersection-with-check
   (list 'a (copy-seq "aaa") 'b)
   (list 'd (copy-seq "aaa") 'e))
  nil)

(deftest nintersection.9
  (nintersection-with-check
   (list 'a (copy-seq "aaa") 'b)
   (list 'd (copy-seq "aaa") 'e)
   :test #'equal)
  ("aaa"))

(deftest nintersection.9-a
  (nintersection-with-check
   (list 'a (copy-seq "aaa") 'b)
   (list 'd (copy-seq "aaa") 'e)
   :test 'equal)
  ("aaa"))

(deftest nintersection.9-b
  (nintersection
   (list 'a (copy-seq "aaa") 'b)
   (list 'd (copy-seq "aaa") 'e)
   :test-not #'(lambda (p q) (not (equal p q))))
  ("aaa"))

(deftest nintersection.10
  (equalt
   (sort
    (let ((result
sds's avatar
sds committed
92 93 94
           (nintersection-with-check
            (loop for i from 0 to 1000 by 3 collect i)
            (loop for i from 0 to 1000 by 7 collect i))))
95 96 97 98 99 100 101 102 103
      (if (eqt result 'failed) () result))
    #'<)
   (loop for i from 0 to 1000 by 21 collect i))
  t)

(deftest nintersection.11
  (equalt
   (sort
    (let ((result
sds's avatar
sds committed
104 105 106 107 108 109
           (nintersection-with-check
            (loop 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))))))
110 111 112 113 114 115 116 117 118 119 120 121 122 123
      (if (eqt result 'failed) () result))
    #'<)
   (loop
    for i from 0 to 999 by (* 3 5 7) collect i))
  t)

(deftest nintersection.12
  (nintersection-12-body 100 100)
  nil)

;; Key argument

(deftest nintersection.13
  (let ((x '(0 5 8 13 31 42))
sds's avatar
sds committed
124
        (y (copy-list '(3 5 42 0 7 100 312 33))))
125 126
    (equalt
     (sort (copy-list (nintersection
sds's avatar
sds committed
127
                       (copy-list x) y)) #'<)
128
     (sort (copy-list (nintersection
sds's avatar
sds committed
129
                       (copy-list x) y :key #'1+)) #'<)))
130 131 132 133 134 135 136
  t)

;; Check that a nil key argument is ignored

(deftest nintersection.14
  (let
      ((result (nintersection
sds's avatar
sds committed
137 138 139
                (copy-list '(a b c d))
                (copy-list '(e c f b g))
                :key nil)))
140 141 142 143 144
    (and
     (member 'b result)
     (member 'c result)
     (every #'(lambda (x) (member x '(b c))) result)
     t))
sds's avatar
sds committed
145
  t)
146 147 148 149 150

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

(deftest nintersection.15
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
151
        (list2 (list 4 5 6 7)))
152 153 154 155 156
    (block fail
      (nintersection
       list1 list2
       :test
       #'(lambda (x y)
sds's avatar
sds committed
157 158
           (when (< y x) (return-from fail 'fail))
           (eql x y)))))
159 160 161 162
  (4))

(deftest nintersection.16
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
163
        (list2 (list 4 5 6 7)))
164 165 166 167 168 169
    (block fail
      (nintersection
       list1 list2
       :key #'identity
       :test
       #'(lambda (x y)
sds's avatar
sds committed
170 171
           (when (< y x) (return-from fail 'fail))
           (eql x y)))))
172 173 174 175
  (4))

(deftest nintersection.17
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
176
        (list2 (list 4 5 6 7)))
177 178 179 180 181
    (block fail
      (nintersection
       list1 list2
       :test-not
       #'(lambda (x y)
sds's avatar
sds committed
182 183
           (when (< y x) (return-from fail 'fail))
           (not (eql x y))))))
184 185 186 187
  (4))

(deftest nintersection.18
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
188
        (list2 (list 4 5 6 7)))
189 190 191 192 193 194
    (block fail
      (nintersection
       list1 list2
       :key #'identity
       :test-not
       #'(lambda (x y)
sds's avatar
sds committed
195 196
           (when (< y x) (return-from fail 'fail))
           (not (eql x y))))))
197 198
  (4))

199 200 201 202 203 204
(defharmless nintersection.test-and-test-not.1
  (nintersection (list 'a 'b 'c) (list 'a 'c 'e) :test #'eql :test-not #'eql))

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

205 206 207 208 209 210
;;; Order of argument evaluation tests

(deftest nintersection.order.1
  (let ((i 0) x y)
    (values
     (nintersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
211
                   (progn (setf y (incf i)) (list 'c 'd)))
212 213 214 215 216 217 218
     i x y))
  nil 2 1 2)

(deftest nintersection.order.2
  (let ((i 0) x y)
    (values
     (nintersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
219 220
                   (progn (setf y (incf i)) (list 'c 'd))
                   :test #'eq)
221 222 223 224 225 226 227
     i x y))
  nil 2 1 2)

(deftest nintersection.order.3
  (let ((i 0) x y z w)
    (values
     (nintersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
228 229 230 231
                   (progn (setf y (incf i)) (list 'c 'd))
                   :test (progn (setf z (incf i)) #'eq)
                   :test (progn (setf w (incf i))
                                (complement #'eq)))
232 233 234 235 236 237 238
     i x y z w))
  nil 4 1 2 3 4)

(deftest nintersection.order.4
  (let ((i 0) x y z w)
    (values
     (nintersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
239 240 241
                   (progn (setf y (incf i)) (list 'c 'd))
                   :test (progn (setf z (incf i)) #'eq)
                   :key (progn (setf w (incf i)) #'identity))
242 243 244 245 246 247 248
     i x y z w))
  nil 4 1 2 3 4)

(deftest nintersection.order.5
  (let ((i 0) x y z w)
    (values
     (nintersection (progn (setf x (incf i)) (list 'a 'b))
sds's avatar
sds committed
249 250 251
                   (progn (setf y (incf i)) (list 'c 'd))
                   :key (progn (setf z (incf i)) #'identity)
                   :test (progn (setf w (incf i)) #'eq))
252 253 254 255 256 257 258
     i x y z w))
  nil 4 1 2 3 4)

;;; Keyword tests

(deftest nintersection.allow-other-keys.1
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
259
        (list2 (list 4 5 6 7)))
260 261 262 263 264
    (nintersection list1 list2 :bad t :allow-other-keys 1))
  (4))

(deftest nintersection.allow-other-keys.2
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
265
        (list2 (list 4 5 6 7)))
266 267 268 269 270
    (nintersection list1 list2 :allow-other-keys :foo :also-bad t))
  (4))

(deftest nintersection.allow-other-keys.3
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
271
        (list2 (list 4 5 6 7)))
272
    (nintersection list1 list2 :allow-other-keys :foo :also-bad t
sds's avatar
sds committed
273
                  :test #'(lambda (x y) (= x (1+ y)))))
274 275 276 277
  nil)

(deftest nintersection.allow-other-keys.4
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
278
        (list2 (list 4 5 6 7)))
279 280 281 282 283
    (nintersection list1 list2 :allow-other-keys t))
  (4))

(deftest nintersection.allow-other-keys.5
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
284
        (list2 (list 4 5 6 7)))
285 286 287 288 289
    (nintersection list1 list2 :allow-other-keys nil))
  (4))

(deftest nintersection.allow-other-keys.6
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
290
        (list2 (list 4 5 6 7)))
291
    (nintersection list1 list2 :allow-other-keys t
sds's avatar
sds committed
292
                  :allow-other-keys nil :bad t))
293 294 295 296 297
  (4))

(deftest nintersection.allow-other-keys.7
  (sort
   (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
298
         (list2 (list 4 5 6 7)))
299
     (nintersection list1 list2 :allow-other-keys t
sds's avatar
sds committed
300 301
                   :allow-other-keys nil
                   :test #'(lambda (x y) (eql x (1- y)))))
302 303 304 305 306 307
   #'<)
  (3 4))

(deftest nintersection.keywords.8
  (sort
   (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
308
         (list2 (list 4 5 6 7)))
309
     (nintersection list1 list2
sds's avatar
sds committed
310 311
                   :test #'(lambda (x y) (eql x (1- y)))
                   :test #'eql))
312 313 314 315 316
   #'<)
  (3 4))

(deftest nintersection.allow-other-keys.9
  (let ((list1 (list 1 2 3 4))
sds's avatar
sds committed
317
        (list2 (list 4 5 6 7)))
318
    (nintersection list1 list2 :allow-other-keys :foo :also-bad t
sds's avatar
sds committed
319
                  :test #'(lambda (x y) (= x (1+ y)))))
320 321 322
  nil)

(deftest nintersection.error.1
323 324
  (signals-error (nintersection) program-error)
  t)
325 326

(deftest nintersection.error.2
327 328
  (signals-error (nintersection nil) program-error)
  t)
329 330

(deftest nintersection.error.3
331 332
  (signals-error (nintersection nil nil :bad t) program-error)
  t)
333 334

(deftest nintersection.error.4
335 336
  (signals-error (nintersection nil nil :key) program-error)
  t)
337 338

(deftest nintersection.error.5
339 340
  (signals-error (nintersection nil nil 1 2) program-error)
  t)
341 342

(deftest nintersection.error.6
343 344
  (signals-error (nintersection nil nil :bad t :allow-other-keys nil) program-error)
  t)
345 346

(deftest nintersection.error.7
347 348
  (signals-error (nintersection (list 1 2 3) (list 4 5 6) :test #'identity) program-error)
  t)
349 350

(deftest nintersection.error.8
351 352
  (signals-error (nintersection (list 1 2 3) (list 4 5 6) :test-not #'identity) program-error)
  t)
353 354

(deftest nintersection.error.9
355 356
  (signals-error (nintersection (list 1 2 3) (list 4 5 6) :key #'cons) program-error)
  t)
357 358

(deftest nintersection.error.10
359 360
  (signals-error (nintersection (list 1 2 3) (list 4 5 6) :key #'car) type-error)
  t)
361 362

(deftest nintersection.error.11
363 364
  (signals-error (nintersection (list 1 2 3) (list* 4 5 6 7)) type-error)
  t)
365 366

(deftest nintersection.error.12
367 368
  (signals-error (nintersection (list* 1 2 3) (list 4 5 6)) type-error)
  t)
369

pfdietz's avatar
pfdietz committed
370 371 372 373 374 375
(deftest nintersection.error.13
  (check-type-error #'(lambda (x) (nintersection x (copy-seq '(a b c)))) #'listp)
  nil)

(deftest nintersection.error.14
  (check-type-error #'(lambda (x) (nintersection (copy-seq '(a b c)) x)) #'listp)
sds's avatar
sds committed
376
  nil)