remove-duplicates.lsp 12.8 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Sep 29 20:49:47 2002
;;;; Contains: Tests for REMOVE-DUPLICATES, DELETE-DUPLICATES

(in-package :cl-test)

8 9


10

11
(deftest random-remove-duplicates
12
  (loop for result = (random-test-remove-dups (1+ (random 20)))
sds's avatar
sds committed
13 14 15
        repeat 1000
        unless (eq result t)
        collect result)
16
  nil)
17 18

(deftest random-delete-duplicates
19
  (loop for result = (random-test-remove-dups (1+ (random 20)) nil)
sds's avatar
sds committed
20 21 22
        repeat 1000
        unless (eq result t)
        collect result)
23
  nil)
24 25 26 27 28

;;; Look for :KEY NIL bugs

(deftest remove-duplicates.1
  (let* ((orig '(1 2 3 4 1 3 4 1 2 5 6 2 7))
sds's avatar
sds committed
29 30
         (x (copy-seq orig))
         (y (remove-duplicates x :key nil)))
31 32 33 34 35
    (and (equalp orig x) y))
  (3 4 1 5 6 2 7))

(deftest delete-duplicates.1
  (let* ((orig '(1 2 3 4 1 3 4 1 2 5 6 2 7))
sds's avatar
sds committed
36 37
         (x (copy-seq orig))
         (y (delete-duplicates x :key nil)))
38 39 40
    y)
  (3 4 1 5 6 2 7))

41 42
(defharmless remove-duplicates.test-and-test-not.1
  (remove-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test #'eql
sds's avatar
sds committed
43
                     :test-not #'eql))
44 45 46

(defharmless remove-duplicates.test-and-test-not.2
  (remove-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql
sds's avatar
sds committed
47
                     :test #'eql))
48 49 50

(defharmless delete-duplicates.test-and-test-not.1
  (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test #'eql
sds's avatar
sds committed
51
                     :test-not #'eql))
52 53 54

(defharmless delete-duplicates.test-and-test-not.2
  (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql
sds's avatar
sds committed
55
                     :test #'eql))
56

57 58
;;; Const fold tests

59 60 61 62
(def-fold-test remove-duplicates.fold.1 (remove-duplicates '(1 2 3 3)))
(def-fold-test remove-duplicates.fold.2 (remove-duplicates #(1 2 3 3)))
(def-fold-test remove-duplicates.fold.3 (remove-duplicates #*0011))
(def-fold-test remove-duplicates.fold.4 (remove-duplicates "1233"))
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 92

;;; Order of evaluation tests

(deftest remove-duplicates.order.1
  (let ((i 0) a b c d e f)
    (values
     (remove-duplicates
      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
      :from-end (progn (setf b (incf i)) nil)
      :start (progn (setf c (incf i)) 0)
      :end (progn (setf d (incf i)) nil)
      :key (progn (setf e (incf i)) #'identity)
      :test (progn (setf f (incf i)) #'=)
      )
     i a b c d e f))
  (3 1 2 4) 6 1 2 3 4 5 6)

(deftest remove-duplicates.order.2
  (let ((i 0) a b c d e f)
    (values
     (remove-duplicates
      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
      :test-not (progn (setf b (incf i)) #'/=)
      :key (progn (setf c (incf i)) #'identity)
      :end (progn (setf d (incf i)) nil)
      :start (progn (setf e (incf i)) 0)
      :from-end (progn (setf f (incf i)) nil)
      )
     i a b c d e f))
  (3 1 2 4) 6 1 2 3 4 5 6)
sds's avatar
sds committed
93

94

95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
;;; Keyword tests

(deftest remove-duplicates.allow-other-keys.1
  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys t)
  (3 4 2 7 8 1 5))

(deftest remove-duplicates.allow-other-keys.2
  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys nil)
  (3 4 2 7 8 1 5))

(deftest remove-duplicates.allow-other-keys.3
  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :bad t :allow-other-keys t)
  (3 4 2 7 8 1 5))

(deftest remove-duplicates.allow-other-keys.4
  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys t :bad t)
  (3 4 2 7 8 1 5))

(deftest remove-duplicates.allow-other-keys.5
  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :bad t
sds's avatar
sds committed
115
                     :allow-other-keys t :allow-other-keys nil)
116 117 118 119
  (3 4 2 7 8 1 5))

(deftest remove-duplicates.allow-other-keys.6
  (remove-duplicates '(1 2 3 4 2 7 8 1 5)
sds's avatar
sds committed
120
                     :allow-other-keys t :bad t :allow-other-keys nil)
121 122 123 124
  (3 4 2 7 8 1 5))

(deftest remove-duplicates.allow-other-keys.7
  (remove-duplicates '(1 2 3 4 2 7 8 1 5)
sds's avatar
sds committed
125
                     :allow-other-keys t :allow-other-keys nil :bad t)
126 127 128 129
  (3 4 2 7 8 1 5))

(deftest remove-duplicates.allow-other-keys.8
  (remove-duplicates '(1 2 3 4 2 7 8 1 5)
sds's avatar
sds committed
130
                     :allow-other-keys t :from-end t)
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
  (1 2 3 4 7 8 5))

(deftest remove-duplicates.keywords.1
  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :from-end t :from-end nil)
  (1 2 3 4 7 8 5))


(deftest delete-duplicates.allow-other-keys.1
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys t)
  (3 4 2 7 8 1 5))

(deftest delete-duplicates.allow-other-keys.2
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys nil)
  (3 4 2 7 8 1 5))

(deftest delete-duplicates.allow-other-keys.3
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :bad t :allow-other-keys t)
  (3 4 2 7 8 1 5))

(deftest delete-duplicates.allow-other-keys.4
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys t :bad t)
  (3 4 2 7 8 1 5))

(deftest delete-duplicates.allow-other-keys.5
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :bad t
sds's avatar
sds committed
156
                     :allow-other-keys t :allow-other-keys nil)
157 158 159 160
  (3 4 2 7 8 1 5))

(deftest delete-duplicates.allow-other-keys.6
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5)
sds's avatar
sds committed
161
                     :allow-other-keys t :bad t :allow-other-keys nil)
162 163 164 165
  (3 4 2 7 8 1 5))

(deftest delete-duplicates.allow-other-keys.7
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5)
sds's avatar
sds committed
166
                     :allow-other-keys t :allow-other-keys nil :bad t)
167 168 169 170
  (3 4 2 7 8 1 5))

(deftest delete-duplicates.allow-other-keys.8
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5)
sds's avatar
sds committed
171
                     :allow-other-keys t :from-end t)
172 173 174 175 176 177
  (1 2 3 4 7 8 5))

(deftest delete-duplicates.keywords.1
  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :from-end t :from-end nil)
  (1 2 3 4 7 8 5))

178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
;;; Order of evaluation tests

(deftest delete-duplicates.order.1
  (let ((i 0) a b c d e f)
    (values
     (delete-duplicates
      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
      :from-end (progn (setf b (incf i)) nil)
      :start (progn (setf c (incf i)) 0)
      :end (progn (setf d (incf i)) nil)
      :key (progn (setf e (incf i)) #'identity)
      :test (progn (setf f (incf i)) #'=)
      )
     i a b c d e f))
  (3 1 2 4) 6 1 2 3 4 5 6)

(deftest delete-duplicates.order.2
  (let ((i 0) a b c d e f)
    (values
     (delete-duplicates
      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
      :test-not (progn (setf b (incf i)) #'/=)
      :key (progn (setf c (incf i)) #'identity)
      :end (progn (setf d (incf i)) nil)
      :start (progn (setf e (incf i)) 0)
      :from-end (progn (setf f (incf i)) nil)
      )
     i a b c d e f))
  (3 1 2 4) 6 1 2 3 4 5 6)
sds's avatar
sds committed
207

208 209 210
;;; Error cases

(deftest remove-duplicates.error.1
211 212
  (signals-error (remove-duplicates) program-error)
  t)
213 214

(deftest remove-duplicates.error.2
215 216
  (signals-error (remove-duplicates nil :start) program-error)
  t)
217 218

(deftest remove-duplicates.error.3
219 220
  (signals-error (remove-duplicates nil 'bad t) program-error)
  t)
221 222

(deftest remove-duplicates.error.4
223 224
  (signals-error (remove-duplicates nil 'bad t :allow-other-keys nil) program-error)
  t)
225 226

(deftest remove-duplicates.error.5
227 228
  (signals-error (remove-duplicates nil 1 2) program-error)
  t)
229

230
(deftest remove-duplicates.error.6
231 232
  (signals-error (remove-duplicates (list 'a 'b 'c) :test #'identity) program-error)
  t)
233 234

(deftest remove-duplicates.error.7
235 236
  (signals-error (remove-duplicates (list 'a 'b 'c) :test-not #'identity) program-error)
  t)
237 238

(deftest remove-duplicates.error.8
239 240
  (signals-error (remove-duplicates (list 'a 'b 'c) :key #'cons) program-error)
  t)
241 242

(deftest remove-duplicates.error.9
243 244
  (signals-error (remove-duplicates (list 'a 'b 'c) :key #'car) type-error)
  t)
245

pfdietz's avatar
pfdietz committed
246
(deftest remove-duplicates.error.10
247 248 249
  (check-type-error #'remove-duplicates #'sequencep)
  nil)

250 251
;;;

252
(deftest delete-duplicates.error.1
253 254
  (signals-error (delete-duplicates) program-error)
  t)
255 256

(deftest delete-duplicates.error.2
257 258
  (signals-error (delete-duplicates nil :start) program-error)
  t)
259 260

(deftest delete-duplicates.error.3
261 262
  (signals-error (delete-duplicates nil 'bad t) program-error)
  t)
263 264

(deftest delete-duplicates.error.4
265 266
  (signals-error (delete-duplicates nil 'bad t :allow-other-keys nil) program-error)
  t)
267 268

(deftest delete-duplicates.error.5
269 270
  (signals-error (delete-duplicates nil 1 2) program-error)
  t)
271

272
(deftest delete-duplicates.error.6
273 274
  (signals-error (delete-duplicates (list 'a 'b 'c) :test #'identity) program-error)
  t)
275

276
(deftest delete-duplicates.error.7
277 278
  (signals-error (delete-duplicates (list 'a 'b 'c) :test-not #'identity) program-error)
  t)
279

280
(deftest delete-duplicates.error.8
281 282
  (signals-error (delete-duplicates (list 'a 'b 'c) :key #'cons) program-error)
  t)
283

284
(deftest delete-duplicates.error.9
285
  (signals-error (delete-duplicates (list 'a 'b 'c) :key #'car) type-error)
286 287
  t)

288 289 290 291
(deftest delete-duplicates.error.10
  (check-type-error #'delete-duplicates #'sequencep)
  nil)

292 293 294 295 296 297 298 299
;;; Specialized string tests

(deftest remove-duplicates.string.1
  (do-special-strings
   (s "abcadefabgz" nil)
   (let ((s2 (remove-duplicates s)))
     (assert (string= s "abcadefabgz"))
     (assert (equal (array-element-type s)
sds's avatar
sds committed
300
                    (array-element-type s2)))
301 302 303 304 305 306 307 308 309
     (assert (string= s2 "cdefabgz"))))
  nil)

(deftest remove-duplicates.string.2
  (do-special-strings
   (s "abcadefabgz" nil)
   (let ((s2 (remove-duplicates s :from-end t)))
     (assert (string= s "abcadefabgz"))
     (assert (equal (array-element-type s)
sds's avatar
sds committed
310
                    (array-element-type s2)))
311 312 313 314 315 316 317
     (assert (string= s2 "abcdefgz"))))
  nil)

(deftest delete-duplicates.string.1
  (do-special-strings
   (s "abcadefabgz" nil)
   (let ((aet (array-element-type s))
sds's avatar
sds committed
318
         (s2 (delete-duplicates s)))
319 320 321 322 323 324 325 326
     (assert (equal aet (array-element-type s2)))
     (assert (string= s2 "cdefabgz"))))
  nil)

(deftest delete-duplicates.string.2
  (do-special-strings
   (s "abcadefabgz" nil)
   (let ((aet (array-element-type s))
sds's avatar
sds committed
327
         (s2 (delete-duplicates s :from-end t)))
328 329 330 331
     (assert (equal aet (array-element-type s2)))
     (assert (string= s2 "abcdefgz"))))
  nil)

332
;;; Order of elements kept under EQUAL, EQUALP tests
333

334 335
(deftest remove-duplicates.2
  (let* ((x (list 'a))
sds's avatar
sds committed
336 337
         (y (list 'a))
         (result (remove-duplicates (list x y) :test 'equal)))
338 339 340 341 342 343 344 345
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) nil t)

(deftest remove-duplicates.2a
  (let* ((x (list 'a))
sds's avatar
sds committed
346 347
         (y (list 'a))
         (result (remove-duplicates (list x 'x y) :test 'equal)))
348 349 350 351 352 353 354 355
    (values
     result
     (notnot (eql (cadr result) x))
     (notnot (eql (cadr result) y))))
  (x (a)) nil t)

(deftest remove-duplicates.3
  (let* ((x (list 'a))
sds's avatar
sds committed
356 357
         (y (list 'a))
         (result (remove-duplicates (list x y) :test 'equal :from-end t)))
358 359 360 361 362 363 364 365
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) t nil)

(deftest remove-duplicates.3a
  (let* ((x (list 'a))
sds's avatar
sds committed
366 367
         (y (list 'a))
         (result (remove-duplicates (list x 'u 'v y) :test 'equal :from-end t)))
368 369 370 371 372 373 374 375
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a) u v) t nil)

(deftest remove-duplicates.4
  (let* ((x (list 'a))
sds's avatar
sds committed
376 377
         (y (list 'a))
         (result (remove-duplicates (list x y) :test 'equalp)))
378 379 380 381 382 383 384 385
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) nil t)

(deftest remove-duplicates.5
  (let* ((x (list 'a))
sds's avatar
sds committed
386 387
         (y (list 'a))
         (result (remove-duplicates (list x y) :test 'equalp :from-end t)))
388 389 390 391 392 393 394 395 396 397
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) t nil)

;;; Similar, but destructive

(deftest delete-duplicates.2
  (let* ((x (list 'a))
sds's avatar
sds committed
398 399
         (y (list 'a))
         (result (delete-duplicates (list x y) :test 'equal)))
400 401 402 403 404 405 406 407
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) nil t)

(deftest delete-duplicates.2a
  (let* ((x (list 'a))
sds's avatar
sds committed
408 409
         (y (list 'a))
         (result (delete-duplicates (list x 'x y) :test 'equal)))
410 411 412 413 414 415 416 417
    (values
     result
     (notnot (eql (cadr result) x))
     (notnot (eql (cadr result) y))))
  (x (a)) nil t)

(deftest delete-duplicates.3
  (let* ((x (list 'a))
sds's avatar
sds committed
418 419
         (y (list 'a))
         (result (delete-duplicates (list x y) :test 'equal :from-end t)))
420 421 422 423 424 425 426 427
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) t nil)

(deftest delete-duplicates.3a
  (let* ((x (list 'a))
sds's avatar
sds committed
428 429
         (y (list 'a))
         (result (delete-duplicates (list x 'u 'v y) :test 'equal :from-end t)))
430 431 432 433 434 435 436 437
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a) u v) t nil)

(deftest delete-duplicates.4
  (let* ((x (list 'a))
sds's avatar
sds committed
438 439
         (y (list 'a))
         (result (delete-duplicates (list x y) :test 'equalp)))
440 441 442 443 444 445 446 447
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) nil t)

(deftest delete-duplicates.5
  (let* ((x (list 'a))
sds's avatar
sds committed
448 449
         (y (list 'a))
         (result (delete-duplicates (list x y) :test 'equalp :from-end t)))
450 451 452 453 454 455 456 457
    (values
     result
     (notnot (eql (car result) x))
     (notnot (eql (car result) y))))
  ((a)) t nil)



458 459


sds's avatar
sds committed
460 461 462