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

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

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

File size: 27.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Sep 14 11:46:05 2002
4;;;; Contains: Tests for REMOVE
5
6(compile-and-load "remove-aux.lsp")
7
8(in-package :cl-test)
9
10(deftest remove-list.1
11  (let* ((orig '(a b c a b d a c b a e))
12         (x (copy-seq orig))
13         (y (remove 'a x)))
14    (and (equalp orig x) y))
15  (b c b d c b e))
16
17(deftest remove-list.2
18  (let* ((orig '(a b c a b d a c b a e))
19         (x (copy-seq orig))
20         (y (remove 'a x :count nil)))
21    (and (equalp orig x) y))
22  (b c b d c b e))
23
24(deftest remove-list.3
25  (let* ((orig '(a b c a b d a c b a e))
26         (x (copy-seq orig))
27         (y (remove 'a x :key nil)))
28    (and (equalp orig x) y))
29  (b c b d c b e))
30
31(deftest remove-list.4
32  (let* ((orig '(a b c a b d a c b a e))
33         (x (copy-seq orig))
34         (y (remove 'a x :count 100)))
35    (and (equalp orig x) y))
36  (b c b d c b e))
37
38(deftest remove-list.5
39  (let* ((orig '(a b c a b d a c b a e))
40         (x (copy-seq orig))
41         (y (remove 'a x :count 0)))
42    (and (equalp orig x) y))
43  (a b c a b d a c b a e))
44
45(deftest remove-list.6
46  (let* ((orig '(a b c a b d a c b a e))
47         (x (copy-seq orig))
48         (y (remove 'a x :count 1)))
49    (and (equalp orig x) y))
50  (b c a b d a c b a e))
51
52(deftest remove-list.7
53  (let* ((orig '(a b c a b d a c b a e))
54         (x (copy-seq orig))
55         (y (remove 'c x :count 1)))
56    (and (equalp orig x) y))
57  (a b a b d a c b a e))
58
59(deftest remove-list.8
60  (let* ((orig '(a b c a b d a c b a e))
61         (x (copy-seq orig))
62         (y (remove 'a x :from-end t)))
63    (and (equalp orig x) y))
64  (b c b d c b e))
65
66(deftest remove-list.9
67  (let* ((orig '(a b c a b d a c b a e))
68         (x (copy-seq orig))
69         (y (remove 'a x :from-end t :count 1)))
70    (and (equalp orig x) y))
71  (a b c a b d a c b e))
72
73(deftest remove-list.10
74  (let* ((orig '(a b c a b d a c b a e))
75         (x (copy-seq orig))
76         (y (remove 'a x :from-end t :count 4)))
77    (and (equalp orig x) y))
78  (b c b d c b e))
79
80(deftest remove-list.11
81  (let* ((orig '(a b c a b d a c b a e))
82         (x (copy-seq orig)))
83    (values
84     (loop for i from 0 to 10
85           collect (remove 'a x :start i))
86     (equalp orig x)))
87  ((b c b d c b e)
88   (a b c b d c b e)
89   (a b c b d c b e)
90   (a b c b d c b e)
91   (a b c a b d c b e)
92   (a b c a b d c b e)
93   (a b c a b d c b e)
94   (a b c a b d a c b e)
95   (a b c a b d a c b e)
96   (a b c a b d a c b e)
97   (a b c a b d a c b a e))
98  t) 
99
100(deftest remove-list.12
101 (let* ((orig '(a b c a b d a c b a e))
102         (x (copy-seq orig)))
103    (values
104     (loop for i from 0 to 10
105           collect (remove 'a x :start i :end nil))
106     (equalp orig x)))
107  ((b c b d c b e)
108   (a b c b d c b e)
109   (a b c b d c b e)
110   (a b c b d c b e)
111   (a b c a b d c b e)
112   (a b c a b d c b e)
113   (a b c a b d c b e)
114   (a b c a b d a c b e)
115   (a b c a b d a c b e)
116   (a b c a b d a c b e)
117   (a b c a b d a c b a e))
118  t)
119
120(deftest remove-list.13
121 (let* ((orig '(a b c a b d a c b a e))
122         (x (copy-seq orig)))
123    (values
124     (loop for i from 0 to 10
125           collect (remove 'a x :start i :end 11))
126     (equalp orig x)))
127  ((b c b d c b e)
128   (a b c b d c b e)
129   (a b c b d c b e)
130   (a b c b d c b e)
131   (a b c a b d c b e)
132   (a b c a b d c b e)
133   (a b c a b d c b e)
134   (a b c a b d a c b e)
135   (a b c a b d a c b e)
136   (a b c a b d a c b e)
137   (a b c a b d a c b a e))
138  t)
139
140(deftest remove-list.14
141  (let* ((orig '(a b c a b d a c b a e))
142         (x (copy-seq orig))
143         (y (remove 'a x :end nil)))
144    (and (equalp orig x) y))
145  (b c b d c b e))
146 
147(deftest remove-list.15
148 (let* ((orig '(a b c a b d a c b a e))
149         (x (copy-seq orig)))
150    (values
151     (loop for i from 0 to 9
152           collect (remove 'a x :start i :end 9))
153     (equalp orig x)))
154  ((b c b d c b a e)
155   (a b c b d c b a e)
156   (a b c b d c b a e)
157   (a b c b d c b a e)
158   (a b c a b d c b a e)
159   (a b c a b d c b a e)
160   (a b c a b d c b a e)
161   (a b c a b d a c b a e)
162   (a b c a b d a c b a e)
163   (a b c a b d a c b a e))
164  t)
165
166(deftest remove-list.16
167 (let* ((orig '(a b c a b d a c b a e))
168         (x (copy-seq orig)))
169    (values
170     (loop for i from 0 to 10
171           collect (remove 'a x :start i :end 11 :count 1))
172     (equalp orig x)))
173 ((b c a b d a c b a e)
174  (a b c b d a c b a e)
175  (a b c b d a c b a e)
176  (a b c b d a c b a e)
177  (a b c a b d c b a e)
178  (a b c a b d c b a e)
179  (a b c a b d c b a e)
180  (a b c a b d a c b e)
181  (a b c a b d a c b e)
182  (a b c a b d a c b e)
183  (a b c a b d a c b a e))
184 t)
185
186(deftest remove-list.17
187 (let* ((orig '(a b c a b d a c b a e))
188         (x (copy-seq orig)))
189    (values
190     (loop for i from 0 to 10
191           collect (remove 'a x :start i :end (1+ i)))
192     (equalp orig x)))
193 ((  b c a b d a c b a e)
194  (a b c a b d a c b a e)
195  (a b c a b d a c b a e)
196  (a b c   b d a c b a e)
197  (a b c a b d a c b a e)
198  (a b c a b d a c b a e)
199  (a b c a b d   c b a e)
200  (a b c a b d a c b a e)
201  (a b c a b d a c b a e)
202  (a b c a b d a c b   e)
203  (a b c a b d a c b a e))
204 t)
205
206;;; Show that it tests using EQL, not EQ
207;;; NOTE: this test was bogus, since we can't sure non-EQness is preserved
208#|
209(deftest remove-list.18
210   (let* ((i (1+ most-positive-fixnum))
211          (orig (list i 0 i 1 i 2 3))
212          (x (copy-seq orig))
213          (y (remove (1+ most-positive-fixnum) x)))
214     (and (equalp orig x) y))
215   (0 1 2 3))
216|#
217
218(deftest remove-list.19
219  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
220         (x (copy-seq orig))
221         (y (remove 1 x :key #'1-)))
222    (and (equalp orig x) y))
223  (1 3 6 1 4 1 3 7))
224
225(deftest remove-list.20
226  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
227         (x (copy-seq orig))
228         (y (remove 3 x :test #'>)))
229    (and (equalp orig x) y))
230  (3 6 4 3 7))
231
232(deftest remove-list.21
233  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
234         (x (copy-seq orig))
235         (y (remove 3 x :test '> :from-end t)))
236    (and (equalp orig x) y))
237  (3 6 4 3 7))
238
239(deftest remove-list.22
240  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
241         (x (copy-seq orig))
242         (y (remove 2 x :key nil)))
243    (and (equalp orig x) y))
244  (1 3 6 1 4 1 3 7))
245
246(deftest remove-list.23
247  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
248         (x (copy-seq orig))
249         (y (remove 1 x :key '1-)))
250    (and (equalp orig x) y))
251  (1 3 6 1 4 1 3 7))
252
253(deftest remove-list.24
254  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
255         (x (copy-seq orig))
256         (y (remove 3 x :test-not #'<=)))
257    (and (equalp orig x) y))
258  (3 6 4 3 7))
259
260(deftest remove-list.25
261  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
262         (x (copy-seq orig))
263         (y (remove 3 x :test-not '<= :from-end t)))
264    (and (equalp orig x) y))
265  (3 6 4 3 7))
266
267(deftest remove-list.26
268  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
269         (x (copy-seq orig))
270         (y (remove 3 x :from-end t :start 1 :end 5)))
271    (and (equalp orig x) y))
272  (1 2 2 6 1 2 4 1 3 2 7))
273
274(deftest remove-list.27
275  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
276         (x (copy-seq orig))
277         (y (remove 3 x :count -1)))
278    (and (equalp orig x)
279         (equalpt x y)))
280  t)
281
282(deftest remove-list.28
283  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
284         (x (copy-seq orig))
285         (y (remove 3 x :count -1000000000000)))
286    (and (equalp orig x)
287         (equalpt x y)))
288  t)
289
290(deftest remove-list.29
291  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
292         (x (copy-seq orig))
293         (y (remove 3 x :count 1000000000000)))
294    (and (equalp orig x)
295         y))
296  (1 2 2 6 1 2 4 1 2 7))
297
298;;; Assorted tests of remove and delete on vectors, strings,
299;;; and bit vectors.  These are mostly to exercise bugs previously
300;;; detected by the randomized tests
301
302(deftest remove-vector.1
303  (remove 'a (vector 'b 'c 'd))
304  #(b c d))
305
306(deftest remove-vector.2
307  (remove 'a (vector 'b 'c 'd) :count -1)
308  #(b c d))
309
310(deftest remove-vector.3
311  (remove 'a (vector 'a 'b 'c 'd) :count -1)
312  #(a b c d))
313
314(deftest remove-string.1
315  (remove #\a (copy-seq "abcad"))
316  "bcd")
317
318(deftest remove-string.2
319  (remove #\a (copy-seq "abcad") :count -1)
320  "abcad")
321
322(deftest remove-string.3
323  (remove #\a (copy-seq "bcd") :count -1)
324  "bcd")
325
326(deftest remove-string.4
327  (do-special-strings
328   (s "abcdbad" nil)
329   (let ((s2 (remove #\b s)))
330     (assert (equal (array-element-type s) (array-element-type s2)))
331     (assert (string= s2 "acdad")))
332   (let ((s2 (remove #\b s :count 1)))
333     (assert (equal (array-element-type s) (array-element-type s2)))
334     (assert (string= s2 "acdbad")))
335   (let ((s2 (remove #\b s :count 1 :from-end t)))
336     (assert (equal (array-element-type s) (array-element-type s2)))
337     (assert (string= s2 "abcdad"))))
338  nil)
339
340(deftest delete-vector.1
341  (delete 'a (vector 'b 'c 'd))
342  #(b c d))
343
344(deftest delete-vector.2
345  (delete 'a (vector 'b 'c 'd) :count -1)
346  #(b c d))
347
348(deftest delete-vector.3
349  (delete 'a (vector 'a 'b 'c 'd) :count -1)
350  #(a b c d))
351
352(deftest delete-string.1
353  (delete #\a (copy-seq "abcad"))
354  "bcd")
355
356(deftest delete-string.2
357  (delete #\a (copy-seq "abcad") :count -1)
358  "abcad")
359
360(deftest delete-string.3
361  (delete #\a (copy-seq "bcd") :count -1)
362  "bcd")
363
364(deftest delete-string.4
365  (do-special-strings
366   (s "abcdbad" nil)
367   (let ((s2 (delete #\b s)))
368     (assert (equal (array-element-type s) (array-element-type s2)))
369     (assert (string= s2 "acdad"))))
370  nil)
371
372(deftest delete-string.5
373  (do-special-strings
374   (s "abcdbad" nil)
375   (let ((s2 (delete #\b s :count 1)))
376     (assert (equal (array-element-type s) (array-element-type s2)))
377     (assert (string= s2 "acdbad"))))
378  nil)
379
380(deftest delete-string.6
381  (do-special-strings
382   (s "abcdbad" nil)
383   (let ((s2 (delete #\b s :count 1 :from-end t)))
384     (assert (equal (array-element-type s) (array-element-type s2)))
385     (assert (string= s2 "abcdad"))))
386  nil)
387
388(deftest remove-bit-vector.1
389  (remove 0 (copy-seq #*00011101101))
390  #*111111)
391
392(deftest remove-bit-vector.2
393  (remove 0 (copy-seq #*00011101101) :count -1)
394  #*00011101101)
395
396(deftest remove-bit-vector.3
397  (remove 0 (copy-seq #*11111) :count -1)
398  #*11111)
399
400(deftest delete-bit-vector.1
401  (delete 0 (copy-seq #*00011101101))
402  #*111111)
403
404(deftest delete-bit-vector.2
405  (delete 0 (copy-seq #*00011101101) :count -1)
406  #*00011101101)
407
408(deftest delete-bit-vector.3
409  (delete 0 (copy-seq #*11111) :count -1)
410  #*11111)
411
412;;; test & test-not together is harmless
413
414(defharmless remove-list.test-and-test-not.1
415  (remove 'a '(a b c) :test #'eql :test-not #'eql))
416
417(defharmless remove-list.test-and-test-not.2
418  (remove 'a '(a b c) :test-not #'eql :test #'eql))
419
420(defharmless remove-vector.test-and-test-not.1
421  (remove 'a #(a b c) :test #'eql :test-not #'eql))
422
423(defharmless remove-vector.test-and-test-not.2
424  (remove 'a #(a b c) :test-not #'eql :test #'eql))
425
426(defharmless remove-bit-string.test-and-test-not.1
427  (remove 0 #*0001100100 :test #'eql :test-not #'eql))
428
429(defharmless remove-bit-string.test-and-test-not.2
430  (remove 0 #*0001100100 :test-not #'eql :test #'eql))
431
432(defharmless remove-string.test-and-test-not.1
433  (remove #\0 "0001100100" :test #'eql :test-not #'eql))
434
435(defharmless remove-string.test-and-test-not.2
436  (remove #\0 "0001100100" :test-not #'eql :test #'eql))
437
438
439(defharmless delete-list.test-and-test-not.1
440  (delete 'a (list 'a 'b 'c) :test #'eql :test-not #'eql))
441
442(defharmless delete-list.test-and-test-not.2
443  (delete 'a (list 'a 'b 'c) :test-not #'eql :test #'eql))
444
445(defharmless delete-vector.test-and-test-not.1
446  (delete 'a (vector 'a 'b 'c) :test #'eql :test-not #'eql))
447
448(defharmless delete-vector.test-and-test-not.2
449  (delete 'a (vector 'a 'b 'c) :test-not #'eql :test #'eql))
450
451(defharmless delete-bit-string.test-and-test-not.1
452  (delete 0 (copy-seq #*0001100100) :test #'eql :test-not #'eql))
453
454(defharmless delete-bit-string.test-and-test-not.2
455  (delete 0 (copy-seq #*0001100100) :test-not #'eql :test #'eql))
456
457(defharmless delete-string.test-and-test-not.1
458  (delete #\0 (copy-seq "0001100100") :test #'eql :test-not #'eql))
459
460(defharmless delete-string.test-and-test-not.2
461  (delete #\0 (copy-seq "0001100100") :test-not #'eql :test #'eql))
462
463
464;;; Const fold tests
465
466(def-fold-test remove.fold.1 (remove 'c '(a b c d e)))
467(def-fold-test remove.fold.2 (remove 'c #(a b c d e)))
468(def-fold-test remove.fold.3 (remove 1 #*0011011001))
469(def-fold-test remove.fold.4 (remove #\c "abcde"))
470
471(def-fold-test remove-if.fold.1 (remove-if 'null '(a b nil d e)))
472(def-fold-test remove-if.fold.2 (remove-if #'null #(a b nil d e)))
473(def-fold-test remove-if.fold.3 (remove-if 'plusp #*0011011001))
474(def-fold-test remove-if.fold.4 (remove-if 'digit-char-p "ab0de"))
475
476(def-fold-test remove-if-not.fold.1 (remove-if-not #'identity '(a b nil d e)))
477(def-fold-test remove-if-not.fold.2 (remove-if-not 'identity #(a b nil d e)))
478(def-fold-test remove-if-not.fold.3 (remove-if-not #'zerop #*0011011001))
479(def-fold-test remove-if-not.fold.4 (remove-if-not #'alpha-char-p "ab-de"))
480
481;;; Order of evaluation tests
482
483(deftest remove.order.1
484  (let ((i 0) a b c d e f g h)
485    (values
486     (remove
487      (progn (setf a (incf i)) 'a)
488      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
489      :from-end (progn (setf c (incf i)) t)
490      :count (progn (setf d (incf i)) 1)
491      :key (progn (setf e (incf i)) #'identity)
492      :test (progn (setf f (incf i)) #'eq)
493      :start (progn (setf g (incf i)) 0)
494      :end (progn (setf h (incf i)) nil))
495     i a b c d e f g h))
496  (a b c d f) 8 1 2 3 4 5 6 7 8)
497
498(deftest remove.order.2
499  (let ((i 0) a b c d e f g h)
500    (values
501     (remove
502      (progn (setf a (incf i)) 'a)
503      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
504      :end (progn (setf c (incf i)) nil)
505      :start (progn (setf d (incf i)) 0)
506      :test-not (progn (setf e (incf i)) (complement #'eq))
507      :key (progn (setf f (incf i)) #'identity)
508      :count (progn (setf g (incf i)) 1)
509      :from-end (progn (setf h (incf i)) t)
510      )
511     i a b c d e f g h))
512  (a b c d f) 8 1 2 3 4 5 6 7 8)
513
514(deftest delete.order.1
515  (let ((i 0) a b c d e f g h)
516    (values
517     (delete
518      (progn (setf a (incf i)) 'a)
519      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
520      :from-end (progn (setf c (incf i)) t)
521      :count (progn (setf d (incf i)) 1)
522      :key (progn (setf e (incf i)) #'identity)
523      :test (progn (setf f (incf i)) #'eq)
524      :start (progn (setf g (incf i)) 0)
525      :end (progn (setf h (incf i)) nil))
526     i a b c d e f g h))
527  (a b c d f) 8 1 2 3 4 5 6 7 8)
528
529(deftest delete.order.2
530  (let ((i 0) a b c d e f g h)
531    (values
532     (delete
533      (progn (setf a (incf i)) 'a)
534      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
535      :end (progn (setf c (incf i)) nil)
536      :start (progn (setf d (incf i)) 0)
537      :test-not (progn (setf e (incf i)) (complement #'eq))
538      :key (progn (setf f (incf i)) #'identity)
539      :count (progn (setf g (incf i)) 1)
540      :from-end (progn (setf h (incf i)) t)
541      )
542     i a b c d e f g h))
543  (a b c d f) 8 1 2 3 4 5 6 7 8)
544
545(deftest remove-if.order.1
546  (let ((i 0) a b c d e f g)
547    (values
548     (remove-if
549      (progn (setf a (incf i)) #'(lambda (x) (eq x 'a)))
550      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
551      :from-end (progn (setf c (incf i)) t)
552      :count (progn (setf d (incf i)) 1)
553      :key (progn (setf e (incf i)) #'identity)
554      :start (progn (setf f (incf i)) 0)
555      :end (progn (setf g (incf i)) nil))
556     i a b c d e f g))
557  (a b c d f) 7 1 2 3 4 5 6 7)
558
559(deftest remove-if.order.2
560  (let ((i 0) a b c d e f g)
561    (values
562     (remove-if
563      (progn (setf a (incf i)) #'(lambda (x) (eq x 'a)))
564      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
565      :end (progn (setf c (incf i)) nil)
566      :start (progn (setf d (incf i)) 0)
567      :key (progn (setf e (incf i)) #'identity)
568      :count (progn (setf f (incf i)) 1)
569      :from-end (progn (setf g (incf i)) t)
570      )
571     i a b c d e f g))
572  (a b c d f) 7 1 2 3 4 5 6 7)
573
574(deftest delete-if.order.1
575  (let ((i 0) a b c d e f g)
576    (values
577     (delete-if
578      (progn (setf a (incf i)) #'(lambda (x) (eq x 'a)))
579      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
580      :from-end (progn (setf c (incf i)) t)
581      :count (progn (setf d (incf i)) 1)
582      :key (progn (setf e (incf i)) #'identity)
583      :start (progn (setf f (incf i)) 0)
584      :end (progn (setf g (incf i)) nil))
585     i a b c d e f g))
586  (a b c d f) 7 1 2 3 4 5 6 7)
587
588(deftest delete-if.order.2
589  (let ((i 0) a b c d e f g)
590    (values
591     (delete-if
592      (progn (setf a (incf i)) #'(lambda (x) (eq x 'a)))
593      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
594      :end (progn (setf c (incf i)) nil)
595      :start (progn (setf d (incf i)) 0)
596      :key (progn (setf e (incf i)) #'identity)
597      :count (progn (setf f (incf i)) 1)
598      :from-end (progn (setf g (incf i)) t)
599      )
600     i a b c d e f g))
601  (a b c d f) 7 1 2 3 4 5 6 7)
602
603(deftest remove-if-not.order.1
604  (let ((i 0) a b c d e f g)
605    (values
606     (remove-if-not
607      (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a))))
608      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
609      :from-end (progn (setf c (incf i)) t)
610      :count (progn (setf d (incf i)) 1)
611      :key (progn (setf e (incf i)) #'identity)
612      :start (progn (setf f (incf i)) 0)
613      :end (progn (setf g (incf i)) nil))
614     i a b c d e f g))
615  (a b c d f) 7 1 2 3 4 5 6 7)
616
617(deftest remove-if-not.order.2
618  (let ((i 0) a b c d e f g)
619    (values
620     (remove-if-not
621      (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a))))
622      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
623      :end (progn (setf c (incf i)) nil)
624      :start (progn (setf d (incf i)) 0)
625      :key (progn (setf e (incf i)) #'identity)
626      :count (progn (setf f (incf i)) 1)
627      :from-end (progn (setf g (incf i)) t)
628      )
629     i a b c d e f g))
630  (a b c d f) 7 1 2 3 4 5 6 7)
631
632(deftest delete-if-not.order.1
633  (let ((i 0) a b c d e f g)
634    (values
635     (delete-if-not
636      (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a))))
637      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
638      :from-end (progn (setf c (incf i)) t)
639      :count (progn (setf d (incf i)) 1)
640      :key (progn (setf e (incf i)) #'identity)
641      :start (progn (setf f (incf i)) 0)
642      :end (progn (setf g (incf i)) nil))
643     i a b c d e f g))
644  (a b c d f) 7 1 2 3 4 5 6 7)
645
646(deftest delete-if-not.order.2
647  (let ((i 0) a b c d e f g)
648    (values
649     (delete-if-not
650      (progn (setf a (incf i)) #'(lambda (x) (not (eq x 'a))))
651      (progn (setf b (incf i)) (list 'a 'b 'c 'd 'a 'f))
652      :end (progn (setf c (incf i)) nil)
653      :start (progn (setf d (incf i)) 0)
654      :key (progn (setf e (incf i)) #'identity)
655      :count (progn (setf f (incf i)) 1)
656      :from-end (progn (setf g (incf i)) t)
657      )
658     i a b c d e f g))
659  (a b c d f) 7 1 2 3 4 5 6 7)
660
661;;; Randomized tests
662
663(deftest remove-random
664  (loop for i from 1 to 2500
665        unless (eq (random-test-remove 20) t)
666        do (return *remove-fail-args*))
667  nil)
668
669(deftest remove-if-random
670  (loop for i from 1 to 2500
671        unless (eq (random-test-remove-if 20) t)
672        do (return *remove-fail-args*))
673  nil)
674
675(deftest remove-if-not-random
676  (loop for i from 1 to 2500
677        unless (eq (random-test-remove-if 20 t) t)
678        do (return *remove-fail-args*))
679  nil)
680
681(deftest delete-random
682  (loop for i from 1 to 2500
683        unless (eq (random-test-delete 20) t)
684        do (return *remove-fail-args*))
685  nil)
686
687(deftest delete-if-random
688  (loop for i from 1 to 2500
689        unless (eq (random-test-delete-if 20) t)
690        do (return *remove-fail-args*))
691  nil)
692
693(deftest delete-if-not-random
694  (loop for i from 1 to 2500
695        unless (eq (random-test-delete-if 20 t) t)
696        do (return *remove-fail-args*))
697  nil)
698
699;;; Additional tests with KEY = NIL
700
701(deftest remove-if-list.1
702  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
703         (x (copy-seq orig))
704         (y (remove-if #'evenp x :key nil)))
705    (and (equalp orig x) y))
706  (1 3 1 1 3 7))
707
708(deftest remove-if-list.2
709  (let* ((orig '(a b c a b d a c b a e))
710         (x (copy-seq orig))
711         (y (remove-if #'(lambda (y) (eqt y 'a)) x :key nil)))
712    (and (equalp orig x) y))
713  (b c b d c b e))
714
715(deftest remove-if-not-list.1
716  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
717         (x (copy-seq orig))
718         (y (remove-if-not #'oddp x :key nil)))
719    (and (equalp orig x) y))
720  (1 3 1 1 3 7))
721
722(deftest remove-if-not-list.2
723  (let* ((orig '(a b c a b d a c b a e))
724         (x (copy-seq orig))
725         (y (remove-if-not #'(lambda (y) (not (eqt y 'a))) x :key nil)))
726    (and (equalp orig x) y))
727  (b c b d c b e))
728
729(deftest delete-if-list.1
730  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
731         (x (copy-seq orig))
732         (y (delete-if #'evenp x :key nil)))
733    y)
734  (1 3 1 1 3 7))
735
736(deftest delete-if-list.2
737  (let* ((orig '(a b c a b d a c b a e))
738         (x (copy-seq orig))
739         (y (delete-if #'(lambda (y) (eqt y 'a)) x :key nil)))
740    y)
741  (b c b d c b e))
742
743(deftest delete-if-not-list.1
744  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
745         (x (copy-seq orig))
746         (y (delete-if-not #'oddp x :key nil)))
747    y)
748  (1 3 1 1 3 7))
749
750(deftest delete-if-not-list.2
751  (let* ((orig '(a b c a b d a c b a e))
752         (x (copy-seq orig))
753         (y (delete-if-not #'(lambda (y) (not (eqt y 'a))) x :key nil)))
754    y)
755  (b c b d c b e))
756
757(deftest delete-list.1
758  (let* ((orig '(a b c a b d a c b a e))
759         (x (copy-seq orig))
760         (y (delete 'a x :key nil)))
761    y)
762  (b c b d c b e))
763
764(deftest delete-list.2
765  (let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
766         (x (copy-seq orig))
767         (y (delete 2 x :key nil)))
768    y)
769  (1 3 6 1 4 1 3 7))
770
771;;; Keyword tests
772
773(deftest remove.allow-other-keys.1
774  (remove 'a '(a b c a d) :allow-other-keys t)
775  (b c d))
776
777(deftest remove.allow-other-keys.2
778  (remove 'a '(a b c a d) :allow-other-keys nil)
779  (b c d))
780
781(deftest remove.allow-other-keys.3
782  (remove 'a '(a b c a d) :bad t :allow-other-keys t)
783  (b c d))
784
785(deftest remove.allow-other-keys.4
786  (remove 'a '(a b c a d) :allow-other-keys t :bad t :bad nil)
787  (b c d))
788
789(deftest remove.allow-other-keys.5
790  (remove 'a '(a b c a d) :bad1 t :allow-other-keys t :bad2 t
791          :allow-other-keys nil :bad3 t)
792  (b c d))
793
794(deftest remove.allow-other-keys.6
795  (remove 'a '(a b c a d) :allow-other-keys t :from-end t :count 1)
796  (a b c d))
797
798(deftest remove.keywords.7
799  (remove 'a '(a b c a d) :from-end t :count 1 :from-end nil :count 10)
800  (a b c d))
801
802
803(deftest delete.allow-other-keys.1
804  (delete 'a (copy-seq '(a b c a d)) :allow-other-keys t)
805  (b c d))
806
807(deftest delete.allow-other-keys.2
808  (delete 'a (copy-seq '(a b c a d)) :allow-other-keys nil)
809  (b c d))
810
811(deftest delete.allow-other-keys.3
812  (delete 'a (copy-seq '(a b c a d)) :bad t :allow-other-keys t)
813  (b c d))
814
815(deftest delete.allow-other-keys.4
816  (delete 'a (copy-seq '(a b c a d)) :allow-other-keys t :bad t :bad nil)
817  (b c d))
818
819(deftest delete.allow-other-keys.5
820  (delete 'a (copy-seq '(a b c a d)) :bad1 t :allow-other-keys t :bad2 t
821          :allow-other-keys nil :bad3 t)
822  (b c d))
823
824(deftest delete.allow-other-keys.6
825  (delete 'a (copy-seq '(a b c a d)) :allow-other-keys t :from-end t :count 1)
826  (a b c d))
827
828(deftest delete.keywords.7
829  (delete 'a (copy-seq '(a b c a d))
830          :from-end t :count 1 :from-end nil :count 10)
831  (a b c d))
832
833
834
835;;; Error cases
836
837(deftest remove.error.1
838  (signals-error (remove) program-error)
839  t)
840
841(deftest remove.error.2
842  (signals-error (remove 'a) program-error)
843  t)
844
845(deftest remove.error.3
846  (signals-error (remove 'a nil :key) program-error)
847  t)
848
849(deftest remove.error.4
850  (signals-error (remove 'a nil 'bad t) program-error)
851  t)
852
853(deftest remove.error.4a
854  (signals-error (remove 'a nil nil t) program-error)
855  t)
856
857(deftest remove.error.5
858  (signals-error (remove 'a nil 'bad t :allow-other-keys nil) program-error)
859  t)
860
861(deftest remove.error.6
862  (signals-error (remove 'a nil 1 2) program-error)
863  t)
864
865(deftest remove.error.7
866  (signals-error (remove 'a (list 'a 'b 'c) :test #'identity) program-error)
867  t)
868
869(deftest remove.error.8
870  (signals-error (remove 'a (list 'a 'b 'c) :test-not #'identity) program-error)
871  t)
872
873(deftest remove.error.9
874  (signals-error (remove 'a (list 'a 'b 'c) :key #'cons) program-error)
875  t)
876
877(deftest remove.error.10
878  (signals-error (remove 'a (list 'a 'b 'c) :key #'car) type-error)
879  t)
880
881(deftest remove.error.11
882  (check-type-error #'(lambda (x) (remove 'a x)) #'sequencep)
883  nil)
884
885
886;;;
887
888(deftest delete.error.1
889  (signals-error (delete) program-error)
890  t)
891
892(deftest delete.error.2
893  (signals-error (delete 'a) program-error)
894  t)
895
896(deftest delete.error.3
897  (signals-error (delete 'a nil :key) program-error)
898  t)
899
900(deftest delete.error.4
901  (signals-error (delete 'a nil 'bad t) program-error)
902  t)
903
904(deftest delete.error.5
905  (signals-error (delete 'a nil 'bad t :allow-other-keys nil) program-error)
906  t)
907
908(deftest delete.error.6
909  (signals-error (delete 'a nil 1 2) program-error)
910  t)
911
912(deftest delete.error.7
913  (signals-error (delete 'a (list 'a 'b 'c) :test #'identity) program-error)
914  t)
915
916(deftest delete.error.8
917  (signals-error (delete 'a (list 'a 'b 'c) :test-not #'identity) program-error)
918  t)
919
920(deftest delete.error.9
921  (signals-error (delete 'a (list 'a 'b 'c) :key #'cons) program-error)
922  t)
923
924(deftest delete.error.10
925  (signals-error (delete 'a (list 'a 'b 'c) :key #'car) type-error)
926  t)
927
928(deftest delete.error.11
929  (check-type-error #'(lambda (x) (delete 'a x)) #'sequencep)
930  nil)
931
932;;; More specialized string tests
933
934(deftest remove-if-string.1
935  (do-special-strings
936   (s "ab1c23def4" nil)
937   (let ((s2 (remove-if #'alpha-char-p s)))
938     (assert (equal (array-element-type s)
939                    (array-element-type s2)))
940     (assert (string= s2 "1234"))
941     (assert (string= s "ab1c23def4"))))
942  nil)
943
944(deftest remove-if-string.2
945  (do-special-strings
946   (s "ab1c23def4" nil)
947   (let ((s2 (remove-if #'alpha-char-p s :count 3)))
948     (assert (equal (array-element-type s)
949                    (array-element-type s2)))
950     (assert (string= s2 "123def4"))
951     (assert (string= s "ab1c23def4"))))
952  nil)
953
954(deftest remove-if-string.3
955  (do-special-strings
956   (s "ab1c23def4" nil)
957   (let ((s2 (remove-if #'alpha-char-p s :count 3 :from-end t)))
958     (assert (equal (array-element-type s)
959                    (array-element-type s2)))
960     (assert (string= s2 "ab1c234"))
961     (assert (string= s "ab1c23def4"))))
962  nil)
963
964(deftest remove-if-not-string.1
965  (do-special-strings
966   (s "ab1c23def4" nil)
967   (let ((s2 (remove-if-not #'digit-char-p s)))
968     (assert (equal (array-element-type s)
969                    (array-element-type s2)))
970     (assert (string= s2 "1234"))
971     (assert (string= s "ab1c23def4"))))
972  nil)
973
974(deftest remove-if-not-string.2
975  (do-special-strings
976   (s "ab1c23def4" nil)
977   (let ((s2 (remove-if-not #'digit-char-p s :count 3)))
978     (assert (equal (array-element-type s)
979                    (array-element-type s2)))
980     (assert (string= s2 "123def4"))
981     (assert (string= s "ab1c23def4"))))
982  nil)
983
984(deftest remove-if-not-string.3
985  (do-special-strings
986   (s "ab1c23def4" nil)
987   (let ((s2 (remove-if-not #'digit-char-p s :count 3 :from-end t)))
988     (assert (equal (array-element-type s)
989                    (array-element-type s2)))
990     (assert (string= s2 "ab1c234"))
991     (assert (string= s "ab1c23def4"))))
992  nil)
993
994
995(deftest delete-if-string.1
996  (do-special-strings
997   (s "ab1c23def4" nil)
998   (let ((s2 (delete-if #'alpha-char-p s)))
999     (assert (equal (array-element-type s)
1000                    (array-element-type s2)))
1001     (assert (string= s2 "1234"))))
1002  nil)
1003
1004(deftest delete-if-string.2
1005  (do-special-strings
1006   (s "ab1c23def4" nil)
1007   (let ((s2 (delete-if #'alpha-char-p s :count 3)))
1008     (assert (equal (array-element-type s)
1009                    (array-element-type s2)))
1010     (assert (string= s2 "123def4"))))
1011  nil)
1012
1013(deftest delete-if-string.3
1014  (do-special-strings
1015   (s "ab1c23def4" nil)
1016   (let ((s2 (delete-if #'alpha-char-p s :count 3 :from-end t)))
1017     (assert (equal (array-element-type s)
1018                    (array-element-type s2)))
1019     (assert (string= s2 "ab1c234"))))
1020  nil)
1021
1022(deftest delete-if-not-string.1
1023  (do-special-strings
1024   (s "ab1c23def4" nil)
1025   (let ((s2 (delete-if-not #'digit-char-p s)))
1026     (assert (equal (array-element-type s)
1027                    (array-element-type s2)))
1028     (assert (string= s2 "1234"))))
1029  nil)
1030
1031(deftest delete-if-not-string.2
1032  (do-special-strings
1033   (s "ab1c23def4" nil)
1034   (let ((s2 (delete-if-not #'digit-char-p s :count 3)))
1035     (assert (equal (array-element-type s)
1036                    (array-element-type s2)))
1037     (assert (string= s2 "123def4"))))
1038  nil)
1039
1040(deftest delete-if-not-string.3
1041  (do-special-strings
1042   (s "ab1c23def4" nil)
1043   (let ((s2 (delete-if-not #'digit-char-p s :count 3 :from-end t)))
1044     (assert (equal (array-element-type s)
1045                    (array-element-type s2)))
1046     (assert (string= s2 "ab1c234"))))
1047  nil)
Note: See TracBrowser for help on using the repository browser.