nset-exclusive-or.lsp 10.5 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:47:05 2003
;;;; Contains: Tests of NSET-EXCLUSIVE-OR

(in-package :cl-test)

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

10 11 12 13 14 15
(deftest nset-exclusive-or.1
  (nset-exclusive-or nil nil)
  nil)

(deftest nset-exclusive-or.2
  (let ((result
sds's avatar
sds committed
16
         (nset-exclusive-or-with-check '(a b c) nil)))
17 18 19 20 21
    (check-set-exclusive-or '(a b c) nil result))
  t)

(deftest nset-exclusive-or.3
  (let ((result
sds's avatar
sds committed
22
         (nset-exclusive-or-with-check '(a b c d e f) '(f b d))))
23 24 25 26 27 28 29
    (check-set-exclusive-or '(a b c d e f) '(f b d) result))
  t)

(deftest nset-exclusive-or.4
  (sort
   (copy-list
    (nset-exclusive-or-with-check (shuffle '(1 2 3 4 5 6 7 8))
sds's avatar
sds committed
30
                                  '(10 101 4 74 2 1391 7 17831)))
31 32 33 34 35 36 37 38 39 40 41 42
   #'<)
  (1 3 5 6 8 10 74 101 1391 17831))

(deftest nset-exclusive-or.5
  (check-set-exclusive-or
   nil
   '(a b c d e f g h)
   (nset-exclusive-or-with-check nil '(a b c d e f g h)))
  t)

(deftest nset-exclusive-or.6
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e)
sds's avatar
sds committed
43
                                :key nil)
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
  (c))

(deftest nset-exclusive-or.7
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eq)
  (c))

(deftest nset-exclusive-or.7-a
  (nset-exclusive-or-with-check '(d a b e) '(a b c d e) :test #'eq)
  (c))

(deftest nset-exclusive-or.8
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'eql)
  (c))

(deftest nset-exclusive-or.8-a
  (nset-exclusive-or-with-check '(e d b a) '(a b c d e) :test #'eql)
  (c))

(deftest nset-exclusive-or.8-b
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e)
sds's avatar
sds committed
64
                                :test-not (complement #'eql))
65 66 67 68 69 70 71 72
  (c))

(deftest nset-exclusive-or.9
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e) :test #'equal)
  (c))

(deftest nset-exclusive-or.10
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e)
sds's avatar
sds committed
73
                                :test 'eq)
74 75 76 77
  (c))

(deftest nset-exclusive-or.11
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e)
sds's avatar
sds committed
78
                                :test 'eql)
79 80 81 82
  (c))

(deftest nset-exclusive-or.12
  (nset-exclusive-or-with-check '(a b c d e) '(d a b e)
sds's avatar
sds committed
83
                                :test 'equal)
84 85 86 87 88 89 90 91
  (c))

;;; (deftest nset-exclusive-or.13
;;;    (do-random-nset-exclusive-ors 100 100)
;;;  nil)

(deftest nset-exclusive-or.14
  (nset-exclusive-or-with-check '((a . 1) (b . 2) (c . 3012))
sds's avatar
sds committed
92 93
                                '((a . 10) (c . 3))
                                :key 'car)
94 95 96 97
  ((b . 2)))

(deftest nset-exclusive-or.15
  (nset-exclusive-or-with-check '((a . xx) (b . 2) (c . 3))
sds's avatar
sds committed
98 99
                                '((a . 1) (c . 3313))
                                :key #'car)
100 101 102 103
  ((b . 2)))

(deftest nset-exclusive-or.16
  (nset-exclusive-or-with-check '((a . xx) (b . 2) (c . 3))
sds's avatar
sds committed
104 105 106
                                '((a . 1) (c . 3313))
                                :key #'car
                                :test-not (complement #'eql))
107 108 109 110 111 112 113 114
  ((b . 2)))

;;
;; Check that nset-exclusive-or does not invert
;; the order of the arguments to the test function
;;
(deftest nset-exclusive-or.17
  (let ((list1 '(a b c d))
sds's avatar
sds committed
115
        (list2 '(e f g h)))
116 117 118
    (block fail
      (notnot-mv
       (nset-exclusive-or-with-check
sds's avatar
sds committed
119 120 121 122 123
        list1 list2
        :test #'(lambda (s1 s2)
                  (when (or (member s1 list2)
                            (member s2 list1))
                    (return-from fail 'failed)))))))
124 125 126 127
  t)

(deftest nset-exclusive-or.17-a
  (let ((list1 '(a b c d))
sds's avatar
sds committed
128
        (list2 '(e f g h)))
129 130 131
    (block fail
      (notnot-mv
       (nset-exclusive-or-with-check
sds's avatar
sds committed
132 133 134 135 136 137
        list1 list2
        :key #'identity
        :test #'(lambda (s1 s2)
                  (when (or (member s1 list2)
                            (member s2 list1))
                    (return-from fail 'failed)))))))
138 139 140 141
  t)

(deftest nset-exclusive-or.18
  (let ((list1 '(a b c d))
sds's avatar
sds committed
142
        (list2 '(e f g h)))
143 144 145
    (block fail
      (notnot-mv
       (nset-exclusive-or-with-check
sds's avatar
sds committed
146 147 148 149 150 151 152
        list1 list2
        :test-not
        #'(lambda (s1 s2)
            (when (or (member s1 list2)
                      (member s2 list1))
              (return-from fail 'failed))
            t)))))
153 154 155 156
  t)

(deftest nset-exclusive-or.18-a
  (let ((list1 '(a b c d))
sds's avatar
sds committed
157
        (list2 '(e f g h)))
158 159 160
    (block fail
      (notnot-mv
       (nset-exclusive-or-with-check
sds's avatar
sds committed
161 162 163 164 165 166 167 168
        list1 list2
        :key #'identity
        :test-not
        #'(lambda (s1 s2)
            (when (or (member s1 list2)
                      (member s2 list1))
              (return-from fail 'failed))
            t)))))
169 170
  t)

171 172
(defharmless nset-exclusive-or.test-and-test-not.1
  (nset-exclusive-or (list 1 2 3 4) (list 1 7 3 8)
sds's avatar
sds committed
173
                     :test #'eql :test-not #'eql))
174 175 176

(defharmless nset-exclusive-or.test-and-test-not.2
  (nset-exclusive-or (list 1 2 3 4) (list 1 7 3 8)
sds's avatar
sds committed
177
                     :test-not #'eql :test #'eql))
178

179 180 181 182 183 184 185
;;; Order of argument evaluation tests

(deftest nset-exclusive-or.order.1
  (let ((i 0) x y)
    (values
     (sort
      (nset-exclusive-or (progn (setf x (incf i))
sds's avatar
sds committed
186 187 188
                                (list 1 2 3 4))
                         (progn (setf y (incf i))
                                (list 1 3 6 10)))
189 190 191 192 193 194 195 196 197
      #'<)
     i x y))
  (2 4 6 10) 2 1 2)

(deftest nset-exclusive-or.order.2
  (let ((i 0) x y z)
    (values
     (sort
      (nset-exclusive-or (progn (setf x (incf i))
sds's avatar
sds committed
198 199 200 201 202
                                (list 1 2 3 4))
                         (progn (setf y (incf i))
                                (list 1 3 6 10))
                         :test (progn (setf z (incf i))
                                      #'eql))
203 204 205 206 207 208 209 210 211
      #'<)
     i x y z))
  (2 4 6 10) 3 1 2 3)

(deftest nset-exclusive-or.order.3
  (let ((i 0) x y z w)
    (values
     (sort
      (nset-exclusive-or (progn (setf x (incf i))
sds's avatar
sds committed
212 213 214 215 216 217
                                (list 1 2 3 4))
                         (progn (setf y (incf i))
                                (list 1 3 6 10))
                         :test (progn (setf z (incf i))
                                      #'eql)
                         :key (progn (setf w (incf i)) nil))
218 219 220 221 222 223 224 225 226
      #'<)
     i x y z w))
  (2 4 6 10) 4 1 2 3 4)

(deftest nset-exclusive-or.order.4
  (let ((i 0) x y z w)
    (values
     (sort
      (nset-exclusive-or (progn (setf x (incf i))
sds's avatar
sds committed
227 228 229 230 231 232
                                (list 1 2 3 4))
                         (progn (setf y (incf i))
                                (list 1 3 6 10))
                         :key (progn (setf z (incf i)) nil)
                         :test (progn (setf w (incf i))
                                      #'eql))
233 234 235 236 237 238 239 240 241
      #'<)
     i x y z w))
  (2 4 6 10) 4 1 2 3 4)

(deftest nset-exclusive-or.order.5
  (let ((i 0) x y z w)
    (values
     (sort
      (nset-exclusive-or (progn (setf x (incf i))
sds's avatar
sds committed
242 243 244 245 246 247
                                (list 1 2 3 4))
                         (progn (setf y (incf i))
                                (list 1 3 6 10))
                         :key (progn (setf z (incf i)) nil)
                         :key (progn (setf w (incf i))
                                     (complement #'eql)))
248 249 250 251 252 253 254 255 256
      #'<)
     i x y z w))
  (2 4 6 10) 4 1 2 3 4)


;;; Keyword tests

(deftest nset-exclusive.allow-other-keys.1
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
257 258
                          :bad t :allow-other-keys t)
        #'<)
259 260 261 262
  (1 2 5 6))

(deftest nset-exclusive.allow-other-keys.2
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
263 264
                          :allow-other-keys t :bad t)
        #'<)
265 266 267 268
  (1 2 5 6))

(deftest nset-exclusive.allow-other-keys.3
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
269 270 271
                          :allow-other-keys t :bad t
                          :test #'(lambda (x y) (= x (1- y))))
        #'<)
272 273 274 275
  (1 6))

(deftest nset-exclusive.allow-other-keys.4
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
276 277
                          :allow-other-keys t)
        #'<)
278 279 280 281
  (1 2 5 6))

(deftest nset-exclusive.allow-other-keys.5
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
282 283
                          :allow-other-keys nil)
        #'<)
284 285 286 287
  (1 2 5 6))

(deftest nset-exclusive.allow-other-keys.6
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
288 289 290
                          :allow-other-keys t
                          :allow-other-keys nil)
        #'<)
291 292 293 294
  (1 2 5 6))

(deftest nset-exclusive.allow-other-keys.7
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
295 296 297 298
                          :allow-other-keys t
                          :allow-other-keys nil
                          '#:x 1)
        #'<)
299 300 301 302
  (1 2 5 6))

(deftest nset-exclusive.keywords.8
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
303 304 305
                          :test #'eql
                          :test #'/=)
        #'<)
306 307 308 309
  (1 2 5 6))

(deftest nset-exclusive.keywords.9
  (sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
sds's avatar
sds committed
310 311 312
                          :test #'/=
                          :test #'eql)
        #'<)
313 314 315 316 317 318 319 320 321 322 323
  nil)

;;; Randomized test

(deftest random-nset-exclusive-or
  (random-set-exclusive-or-test 10 1000 'nset-exclusive-or)
  nil)

;;; Error tests

(deftest nset-exclusive-or.error.1
324 325
  (signals-error (nset-exclusive-or) program-error)
  t)
326 327

(deftest nset-exclusive-or.error.2
328 329
  (signals-error (nset-exclusive-or nil) program-error)
  t)
330 331

(deftest nset-exclusive-or.error.3
332 333
  (signals-error (nset-exclusive-or nil nil :bad t) program-error)
  t)
334 335

(deftest nset-exclusive-or.error.4
336 337
  (signals-error (nset-exclusive-or nil nil :key) program-error)
  t)
338 339

(deftest nset-exclusive-or.error.5
340 341
  (signals-error (nset-exclusive-or nil nil 1 2) program-error)
  t)
342 343

(deftest nset-exclusive-or.error.6
344 345
  (signals-error (nset-exclusive-or nil nil :bad t :allow-other-keys nil) program-error)
  t)
346 347

(deftest nset-exclusive-or.error.7
348 349
  (signals-error (nset-exclusive-or (list 1 2) (list 3 4) :test #'identity) program-error)
  t)
350 351

(deftest nset-exclusive-or.error.8
352 353
  (signals-error (nset-exclusive-or (list 1 2) (list 3 4) :test-not #'identity) program-error)
  t)
354 355

(deftest nset-exclusive-or.error.9
356 357
  (signals-error (nset-exclusive-or (list 1 2) (list 3 4) :key #'cons) program-error)
  t)
358 359

(deftest nset-exclusive-or.error.10
360 361
  (signals-error (nset-exclusive-or (list 1 2) (list 3 4) :key #'car) type-error)
  t)
362 363

(deftest nset-exclusive-or.error.11
364 365
  (signals-error (nset-exclusive-or (list 1 2 3) (list* 4 5 6)) type-error)
  t)
366 367

(deftest nset-exclusive-or.error.12
368 369
  (signals-error (nset-exclusive-or (list* 1 2 3) (list 4 5 6)) type-error)
  t)
pfdietz's avatar
pfdietz committed
370 371 372 373 374 375 376 377

(deftest nset-exclusive-or.error.13
  (check-type-error #'(lambda (x) (nset-exclusive-or x (list 'a 'b))) #'listp)
  nil)

(deftest nset-exclusive-or.error.14
  (check-type-error #'(lambda (x) (nset-exclusive-or (list 'a 'b) x)) #'listp)
  nil)