source: trunk/source/tests/ansi-tests/remove-duplicates.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 12.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Sep 29 20:49:47 2002
4;;;; Contains: Tests for REMOVE-DUPLICATES, DELETE-DUPLICATES
5
6(in-package :cl-test)
7
8(compile-and-load "remove-aux.lsp")
9(compile-and-load "remove-duplicates-aux.lsp")
10
11(deftest random-remove-duplicates
12  (loop for result = (random-test-remove-dups (1+ (random 20)))
13        repeat 1000
14        unless (eq result t)
15        collect result)
16  nil)
17
18(deftest random-delete-duplicates
19  (loop for result = (random-test-remove-dups (1+ (random 20)) nil)
20        repeat 1000
21        unless (eq result t)
22        collect result)
23  nil)
24
25;;; Look for :KEY NIL bugs
26
27(deftest remove-duplicates.1
28  (let* ((orig '(1 2 3 4 1 3 4 1 2 5 6 2 7))
29         (x (copy-seq orig))
30         (y (remove-duplicates x :key nil)))
31    (and (equalp orig x) y))
32  (3 4 1 5 6 2 7))
33
34(deftest delete-duplicates.1
35  (let* ((orig '(1 2 3 4 1 3 4 1 2 5 6 2 7))
36         (x (copy-seq orig))
37         (y (delete-duplicates x :key nil)))
38    y)
39  (3 4 1 5 6 2 7))
40
41(defharmless remove-duplicates.test-and-test-not.1
42  (remove-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test #'eql
43                     :test-not #'eql))
44
45(defharmless remove-duplicates.test-and-test-not.2
46  (remove-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql
47                     :test #'eql))
48
49(defharmless delete-duplicates.test-and-test-not.1
50  (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test #'eql
51                     :test-not #'eql))
52
53(defharmless delete-duplicates.test-and-test-not.2
54  (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql
55                     :test #'eql))
56
57;;; Const fold tests
58
59(def-fold-test remove-duplicates.fold.1 (remove-duplicates '(1 2 3 3)))
60(def-fold-test remove-duplicates.fold.2 (remove-duplicates #(1 2 3 3)))
61(def-fold-test remove-duplicates.fold.3 (remove-duplicates #*0011))
62(def-fold-test remove-duplicates.fold.4 (remove-duplicates "1233"))
63
64;;; Order of evaluation tests
65
66(deftest remove-duplicates.order.1
67  (let ((i 0) a b c d e f)
68    (values
69     (remove-duplicates
70      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
71      :from-end (progn (setf b (incf i)) nil)
72      :start (progn (setf c (incf i)) 0)
73      :end (progn (setf d (incf i)) nil)
74      :key (progn (setf e (incf i)) #'identity)
75      :test (progn (setf f (incf i)) #'=)
76      )
77     i a b c d e f))
78  (3 1 2 4) 6 1 2 3 4 5 6)
79
80(deftest remove-duplicates.order.2
81  (let ((i 0) a b c d e f)
82    (values
83     (remove-duplicates
84      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
85      :test-not (progn (setf b (incf i)) #'/=)
86      :key (progn (setf c (incf i)) #'identity)
87      :end (progn (setf d (incf i)) nil)
88      :start (progn (setf e (incf i)) 0)
89      :from-end (progn (setf f (incf i)) nil)
90      )
91     i a b c d e f))
92  (3 1 2 4) 6 1 2 3 4 5 6)
93 
94
95;;; Keyword tests
96
97(deftest remove-duplicates.allow-other-keys.1
98  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys t)
99  (3 4 2 7 8 1 5))
100
101(deftest remove-duplicates.allow-other-keys.2
102  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys nil)
103  (3 4 2 7 8 1 5))
104
105(deftest remove-duplicates.allow-other-keys.3
106  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :bad t :allow-other-keys t)
107  (3 4 2 7 8 1 5))
108
109(deftest remove-duplicates.allow-other-keys.4
110  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :allow-other-keys t :bad t)
111  (3 4 2 7 8 1 5))
112
113(deftest remove-duplicates.allow-other-keys.5
114  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :bad t
115                     :allow-other-keys t :allow-other-keys nil)
116  (3 4 2 7 8 1 5))
117
118(deftest remove-duplicates.allow-other-keys.6
119  (remove-duplicates '(1 2 3 4 2 7 8 1 5)
120                     :allow-other-keys t :bad t :allow-other-keys nil)
121  (3 4 2 7 8 1 5))
122
123(deftest remove-duplicates.allow-other-keys.7
124  (remove-duplicates '(1 2 3 4 2 7 8 1 5)
125                     :allow-other-keys t :allow-other-keys nil :bad t)
126  (3 4 2 7 8 1 5))
127
128(deftest remove-duplicates.allow-other-keys.8
129  (remove-duplicates '(1 2 3 4 2 7 8 1 5)
130                     :allow-other-keys t :from-end t)
131  (1 2 3 4 7 8 5))
132
133(deftest remove-duplicates.keywords.1
134  (remove-duplicates '(1 2 3 4 2 7 8 1 5) :from-end t :from-end nil)
135  (1 2 3 4 7 8 5))
136
137
138(deftest delete-duplicates.allow-other-keys.1
139  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys t)
140  (3 4 2 7 8 1 5))
141
142(deftest delete-duplicates.allow-other-keys.2
143  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys nil)
144  (3 4 2 7 8 1 5))
145
146(deftest delete-duplicates.allow-other-keys.3
147  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :bad t :allow-other-keys t)
148  (3 4 2 7 8 1 5))
149
150(deftest delete-duplicates.allow-other-keys.4
151  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :allow-other-keys t :bad t)
152  (3 4 2 7 8 1 5))
153
154(deftest delete-duplicates.allow-other-keys.5
155  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :bad t
156                     :allow-other-keys t :allow-other-keys nil)
157  (3 4 2 7 8 1 5))
158
159(deftest delete-duplicates.allow-other-keys.6
160  (delete-duplicates (list 1 2 3 4 2 7 8 1 5)
161                     :allow-other-keys t :bad t :allow-other-keys nil)
162  (3 4 2 7 8 1 5))
163
164(deftest delete-duplicates.allow-other-keys.7
165  (delete-duplicates (list 1 2 3 4 2 7 8 1 5)
166                     :allow-other-keys t :allow-other-keys nil :bad t)
167  (3 4 2 7 8 1 5))
168
169(deftest delete-duplicates.allow-other-keys.8
170  (delete-duplicates (list 1 2 3 4 2 7 8 1 5)
171                     :allow-other-keys t :from-end t)
172  (1 2 3 4 7 8 5))
173
174(deftest delete-duplicates.keywords.1
175  (delete-duplicates (list 1 2 3 4 2 7 8 1 5) :from-end t :from-end nil)
176  (1 2 3 4 7 8 5))
177
178;;; Order of evaluation tests
179
180(deftest delete-duplicates.order.1
181  (let ((i 0) a b c d e f)
182    (values
183     (delete-duplicates
184      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
185      :from-end (progn (setf b (incf i)) nil)
186      :start (progn (setf c (incf i)) 0)
187      :end (progn (setf d (incf i)) nil)
188      :key (progn (setf e (incf i)) #'identity)
189      :test (progn (setf f (incf i)) #'=)
190      )
191     i a b c d e f))
192  (3 1 2 4) 6 1 2 3 4 5 6)
193
194(deftest delete-duplicates.order.2
195  (let ((i 0) a b c d e f)
196    (values
197     (delete-duplicates
198      (progn (setf a (incf i)) (list 1 2 3 1 3 1 2 4))
199      :test-not (progn (setf b (incf i)) #'/=)
200      :key (progn (setf c (incf i)) #'identity)
201      :end (progn (setf d (incf i)) nil)
202      :start (progn (setf e (incf i)) 0)
203      :from-end (progn (setf f (incf i)) nil)
204      )
205     i a b c d e f))
206  (3 1 2 4) 6 1 2 3 4 5 6)
207 
208;;; Error cases
209
210(deftest remove-duplicates.error.1
211  (signals-error (remove-duplicates) program-error)
212  t)
213
214(deftest remove-duplicates.error.2
215  (signals-error (remove-duplicates nil :start) program-error)
216  t)
217
218(deftest remove-duplicates.error.3
219  (signals-error (remove-duplicates nil 'bad t) program-error)
220  t)
221
222(deftest remove-duplicates.error.4
223  (signals-error (remove-duplicates nil 'bad t :allow-other-keys nil) program-error)
224  t)
225
226(deftest remove-duplicates.error.5
227  (signals-error (remove-duplicates nil 1 2) program-error)
228  t)
229
230(deftest remove-duplicates.error.6
231  (signals-error (remove-duplicates (list 'a 'b 'c) :test #'identity) program-error)
232  t)
233
234(deftest remove-duplicates.error.7
235  (signals-error (remove-duplicates (list 'a 'b 'c) :test-not #'identity) program-error)
236  t)
237
238(deftest remove-duplicates.error.8
239  (signals-error (remove-duplicates (list 'a 'b 'c) :key #'cons) program-error)
240  t)
241
242(deftest remove-duplicates.error.9
243  (signals-error (remove-duplicates (list 'a 'b 'c) :key #'car) type-error)
244  t)
245
246(deftest remove-duplicates.error.10
247  (check-type-error #'remove-duplicates #'sequencep)
248  nil)
249
250;;;
251
252(deftest delete-duplicates.error.1
253  (signals-error (delete-duplicates) program-error)
254  t)
255
256(deftest delete-duplicates.error.2
257  (signals-error (delete-duplicates nil :start) program-error)
258  t)
259
260(deftest delete-duplicates.error.3
261  (signals-error (delete-duplicates nil 'bad t) program-error)
262  t)
263
264(deftest delete-duplicates.error.4
265  (signals-error (delete-duplicates nil 'bad t :allow-other-keys nil) program-error)
266  t)
267
268(deftest delete-duplicates.error.5
269  (signals-error (delete-duplicates nil 1 2) program-error)
270  t)
271
272(deftest delete-duplicates.error.6
273  (signals-error (delete-duplicates (list 'a 'b 'c) :test #'identity) program-error)
274  t)
275
276(deftest delete-duplicates.error.7
277  (signals-error (delete-duplicates (list 'a 'b 'c) :test-not #'identity) program-error)
278  t)
279
280(deftest delete-duplicates.error.8
281  (signals-error (delete-duplicates (list 'a 'b 'c) :key #'cons) program-error)
282  t)
283
284(deftest delete-duplicates.error.9
285  (signals-error (delete-duplicates (list 'a 'b 'c) :key #'car) type-error)
286  t)
287
288(deftest delete-duplicates.error.10
289  (check-type-error #'delete-duplicates #'sequencep)
290  nil)
291
292;;; Specialized string tests
293
294(deftest remove-duplicates.string.1
295  (do-special-strings
296   (s "abcadefabgz" nil)
297   (let ((s2 (remove-duplicates s)))
298     (assert (string= s "abcadefabgz"))
299     (assert (equal (array-element-type s)
300                    (array-element-type s2)))
301     (assert (string= s2 "cdefabgz"))))
302  nil)
303
304(deftest remove-duplicates.string.2
305  (do-special-strings
306   (s "abcadefabgz" nil)
307   (let ((s2 (remove-duplicates s :from-end t)))
308     (assert (string= s "abcadefabgz"))
309     (assert (equal (array-element-type s)
310                    (array-element-type s2)))
311     (assert (string= s2 "abcdefgz"))))
312  nil)
313
314(deftest delete-duplicates.string.1
315  (do-special-strings
316   (s "abcadefabgz" nil)
317   (let ((aet (array-element-type s))
318         (s2 (delete-duplicates s)))
319     (assert (equal aet (array-element-type s2)))
320     (assert (string= s2 "cdefabgz"))))
321  nil)
322
323(deftest delete-duplicates.string.2
324  (do-special-strings
325   (s "abcadefabgz" nil)
326   (let ((aet (array-element-type s))
327         (s2 (delete-duplicates s :from-end t)))
328     (assert (equal aet (array-element-type s2)))
329     (assert (string= s2 "abcdefgz"))))
330  nil)
331
332;;; Order of elements kept under EQUAL, EQUALP tests
333
334(deftest remove-duplicates.2
335  (let* ((x (list 'a))
336         (y (list 'a))
337         (result (remove-duplicates (list x y) :test 'equal)))
338    (values
339     result
340     (notnot (eql (car result) x))
341     (notnot (eql (car result) y))))
342  ((a)) nil t)
343
344(deftest remove-duplicates.2a
345  (let* ((x (list 'a))
346         (y (list 'a))
347         (result (remove-duplicates (list x 'x y) :test 'equal)))
348    (values
349     result
350     (notnot (eql (cadr result) x))
351     (notnot (eql (cadr result) y))))
352  (x (a)) nil t)
353
354(deftest remove-duplicates.3
355  (let* ((x (list 'a))
356         (y (list 'a))
357         (result (remove-duplicates (list x y) :test 'equal :from-end t)))
358    (values
359     result
360     (notnot (eql (car result) x))
361     (notnot (eql (car result) y))))
362  ((a)) t nil)
363
364(deftest remove-duplicates.3a
365  (let* ((x (list 'a))
366         (y (list 'a))
367         (result (remove-duplicates (list x 'u 'v y) :test 'equal :from-end t)))
368    (values
369     result
370     (notnot (eql (car result) x))
371     (notnot (eql (car result) y))))
372  ((a) u v) t nil)
373
374(deftest remove-duplicates.4
375  (let* ((x (list 'a))
376         (y (list 'a))
377         (result (remove-duplicates (list x y) :test 'equalp)))
378    (values
379     result
380     (notnot (eql (car result) x))
381     (notnot (eql (car result) y))))
382  ((a)) nil t)
383
384(deftest remove-duplicates.5
385  (let* ((x (list 'a))
386         (y (list 'a))
387         (result (remove-duplicates (list x y) :test 'equalp :from-end t)))
388    (values
389     result
390     (notnot (eql (car result) x))
391     (notnot (eql (car result) y))))
392  ((a)) t nil)
393
394;;; Similar, but destructive
395
396(deftest delete-duplicates.2
397  (let* ((x (list 'a))
398         (y (list 'a))
399         (result (delete-duplicates (list x y) :test 'equal)))
400    (values
401     result
402     (notnot (eql (car result) x))
403     (notnot (eql (car result) y))))
404  ((a)) nil t)
405
406(deftest delete-duplicates.2a
407  (let* ((x (list 'a))
408         (y (list 'a))
409         (result (delete-duplicates (list x 'x y) :test 'equal)))
410    (values
411     result
412     (notnot (eql (cadr result) x))
413     (notnot (eql (cadr result) y))))
414  (x (a)) nil t)
415
416(deftest delete-duplicates.3
417  (let* ((x (list 'a))
418         (y (list 'a))
419         (result (delete-duplicates (list x y) :test 'equal :from-end t)))
420    (values
421     result
422     (notnot (eql (car result) x))
423     (notnot (eql (car result) y))))
424  ((a)) t nil)
425
426(deftest delete-duplicates.3a
427  (let* ((x (list 'a))
428         (y (list 'a))
429         (result (delete-duplicates (list x 'u 'v y) :test 'equal :from-end t)))
430    (values
431     result
432     (notnot (eql (car result) x))
433     (notnot (eql (car result) y))))
434  ((a) u v) t nil)
435
436(deftest delete-duplicates.4
437  (let* ((x (list 'a))
438         (y (list 'a))
439         (result (delete-duplicates (list x y) :test 'equalp)))
440    (values
441     result
442     (notnot (eql (car result) x))
443     (notnot (eql (car result) y))))
444  ((a)) nil t)
445
446(deftest delete-duplicates.5
447  (let* ((x (list 'a))
448         (y (list 'a))
449         (result (delete-duplicates (list x y) :test 'equalp :from-end t)))
450    (values
451     result
452     (notnot (eql (car result) x))
453     (notnot (eql (car result) y))))
454  ((a)) t nil)
455
456
457
458   
459   
460
461
462                   
Note: See TracBrowser for help on using the repository browser.