source: trunk/source/tests/ansi-tests/substitute-if-not.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: 26.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Aug 31 18:17:09 2002
4;;;; Contains: Tests for SUBSTITUTE-IF-NOT
5
6(in-package :cl-test)
7
8(deftest substitute-if-not-list.1
9  (let ((x '())) (values (substitute-if-not 'b #'null x) x))
10  nil nil)
11
12(deftest substitute-if-not-list.2
13  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x) x))
14  (b b b c)
15  (a b a c))
16
17(deftest substitute-if-not-list.3
18  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count nil) x))
19  (b b b c)
20  (a b a c))
21
22(deftest substitute-if-not-list.4
23  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2) x))
24  (b b b c)
25  (a b a c))
26
27(deftest substitute-if-not-list.5
28  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1) x))
29  (b b a c)
30  (a b a c))
31
32(deftest substitute-if-not-list.6
33  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0) x))
34  (a b a c)
35  (a b a c))
36
37(deftest substitute-if-not-list.7
38  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1) x))
39  (a b a c)
40  (a b a c))
41
42(deftest substitute-if-not-list.8
43  (let ((x '())) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
44  nil nil)
45
46(deftest substitute-if-not-list.9
47  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
48  (b b b c)
49  (a b a c))
50
51(deftest substitute-if-not-list.10
52  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t :count nil) x))
53  (b b b c)
54  (a b a c))
55
56(deftest substitute-if-not-list.11
57  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2 :from-end t) x))
58  (b b b c)
59  (a b a c))
60
61(deftest substitute-if-not-list.12
62  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1 :from-end t) x))
63  (a b b c)
64  (a b a c))
65
66(deftest substitute-if-not-list.13
67  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0 :from-end t) x))
68  (a b a c)
69  (a b a c))
70
71(deftest substitute-if-not-list.14
72  (let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1 :from-end t) x))
73  (a b a c)
74  (a b a c))
75
76(deftest substitute-if-not-list.15
77  (loop for i from 0 to 9 always
78        (loop for j from i to 10 always
79              (let* ((orig '(a a a a a a a a a a))
80                     (x (copy-seq orig))
81                     (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
82                (and (equal orig x)
83                     (equal y (nconc (make-list i :initial-element 'a)
84                                     (make-list (- j i) :initial-element 'x)
85                                     (make-list (- 10 j) :initial-element 'a)))))))
86  t)
87
88(deftest substitute-if-not-list.16
89  (loop for i from 0 to 9 always
90        (loop for j from i to 10 always
91              (let* ((orig '(a a a a a a a a a a))
92                     (x (copy-seq orig))
93                     (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
94                (and (equal orig x)
95                     (equal y (nconc (make-list i :initial-element 'a)
96                                     (make-list (- j i) :initial-element 'x)
97                                     (make-list (- 10 j) :initial-element 'a)))))))
98  t)
99
100(deftest substitute-if-not-list.17
101  (loop for i from 0 to 9 always
102        (loop for j from i to 10 always
103              (loop for c from 0 to (- j i) always
104                    (let* ((orig '(a a a a a a a a a a))
105                           (x (copy-seq orig))
106                           (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
107                      (and (equal orig x)
108                           (equal y (nconc (make-list i :initial-element 'a)
109                                           (make-list c :initial-element 'x)
110                                           (make-list (- 10 (+ i c)) :initial-element 'a))))))))
111  t)
112
113(deftest substitute-if-not-list.18
114  (loop for i from 0 to 9 always
115        (loop for j from i to 10 always
116              (loop for c from 0 to (- j i) always
117                    (let* ((orig '(a a a a a a a a a a))
118                           (x (copy-seq orig))
119                           (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
120                      (and (equal orig x)
121                           (equal y (nconc (make-list (- j c) :initial-element 'a)
122                                           (make-list c :initial-element 'x)
123                                           (make-list (- 10 j) :initial-element 'a))))))))
124  t)
125
126;;; Tests on vectors
127
128(deftest substitute-if-not-vector.1
129  (let ((x #())) (values (substitute-if-not 'b (is-not-eql-p 'a) x) x))
130  #() #())
131
132(deftest substitute-if-not-vector.2
133  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x) x))
134  #(b b b c)
135  #(a b a c))
136
137(deftest substitute-if-not-vector.3
138  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count nil) x))
139  #(b b b c)
140  #(a b a c))
141
142(deftest substitute-if-not-vector.4
143  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2) x))
144  #(b b b c)
145  #(a b a c))
146
147(deftest substitute-if-not-vector.5
148  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1) x))
149  #(b b a c)
150  #(a b a c))
151
152(deftest substitute-if-not-vector.6
153  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0) x))
154  #(a b a c)
155  #(a b a c))
156
157(deftest substitute-if-not-vector.7
158  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1) x))
159  #(a b a c)
160  #(a b a c))
161
162(deftest substitute-if-not-vector.8
163  (let ((x #())) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
164  #() #())
165
166(deftest substitute-if-not-vector.9
167  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
168  #(b b b c)
169  #(a b a c))
170
171(deftest substitute-if-not-vector.10
172  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t :count nil) x))
173  #(b b b c)
174  #(a b a c))
175
176(deftest substitute-if-not-vector.11
177  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2 :from-end t) x))
178  #(b b b c)
179  #(a b a c))
180
181(deftest substitute-if-not-vector.12
182  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1 :from-end t) x))
183  #(a b b c)
184  #(a b a c))
185
186(deftest substitute-if-not-vector.13
187  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0 :from-end t) x))
188  #(a b a c)
189  #(a b a c))
190
191(deftest substitute-if-not-vector.14
192  (let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1 :from-end t) x))
193  #(a b a c)
194  #(a b a c))
195
196(deftest substitute-if-not-vector.15
197  (loop for i from 0 to 9 always
198        (loop for j from i to 10 always
199              (let* ((orig #(a a a a a a a a a a))
200                     (x (copy-seq orig))
201                     (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
202                (and (equalp orig x)
203                     (equalp y (concatenate 'simple-vector
204                                           (make-array i :initial-element 'a)
205                                           (make-array (- j i) :initial-element 'x)
206                                           (make-array (- 10 j) :initial-element 'a)))))))
207  t)
208
209(deftest substitute-if-not-vector.16
210  (loop for i from 0 to 9 always
211        (loop for j from i to 10 always
212              (let* ((orig #(a a a a a a a a a a))
213                     (x (copy-seq orig))
214                     (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
215                (and (equalp orig x)
216                     (equalp y (concatenate 'simple-vector
217                                           (make-array i :initial-element 'a)
218                                           (make-array (- j i) :initial-element 'x)
219                                           (make-array (- 10 j) :initial-element 'a)))))))
220  t)
221
222(deftest substitute-if-not-vector.17
223  (loop for i from 0 to 9 always
224        (loop for j from i to 10 always
225              (loop for c from 0 to (- j i) always
226                    (let* ((orig #(a a a a a a a a a a))
227                           (x (copy-seq orig))
228                           (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
229                      (and (equalp orig x)
230                           (equalp y (concatenate 'simple-vector
231                                                 (make-array i :initial-element 'a)
232                                                 (make-array c :initial-element 'x)
233                                                 (make-array (- 10 (+ i c)) :initial-element 'a))))))))
234  t)
235
236(deftest substitute-if-not-vector.18
237  (loop for i from 0 to 9 always
238        (loop for j from i to 10 always
239              (loop for c from 0 to (- j i) always
240                    (let* ((orig #(a a a a a a a a a a))
241                           (x (copy-seq orig))
242                           (y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
243                      (and (equalp orig x)
244                           (equalp y (concatenate 'simple-vector
245                                                 (make-array (- j c) :initial-element 'a)
246                                                 (make-array c :initial-element 'x)
247                                                 (make-array (- 10 j) :initial-element 'a))))))))
248  t)
249
250(deftest substitute-if-not-vector.28
251  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
252                       :fill-pointer 5))
253         (result (substitute-if-not 'z (is-not-eql-p 'a) x)))
254    result)
255  #(z b z c b))
256
257(deftest substitute-if-not-vector.29
258  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
259                       :fill-pointer 5))
260         (result (substitute-if-not 'z (is-not-eql-p 'a) x :from-end t)))
261    result)
262  #(z b z c b))
263
264(deftest substitute-if-not-vector.30
265  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
266                       :fill-pointer 5))
267         (result (substitute-if-not 'z (is-not-eql-p 'a) x :count 1)))
268    result)
269  #(z b a c b))
270
271(deftest substitute-if-not-vector.31
272  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
273                       :fill-pointer 5))
274         (result (substitute-if-not 'z (is-not-eql-p 'a) x
275                                    :from-end t :count 1)))
276    result)
277  #(a b z c b))
278
279(deftest substitute-if-not-vector.32
280  (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
281         (v2 (make-array '(8) :displaced-to v1
282                         :displaced-index-offset 3)))
283    (values
284     (substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1)
285     v1))
286  #(d a b x d a b c)
287  #(a b c d a b c d a b c d a b c d))
288
289(deftest substitute-if-not-vector.33
290  (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
291         (v2 (make-array '(8) :displaced-to v1
292                         :displaced-index-offset 3)))
293    (values
294     (substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1 :from-end t)
295     v1))
296  #(d a b c d a b x)
297  #(a b c d a b c d a b c d a b c d))
298
299
300
301;;; Tests on strings
302
303(deftest substitute-if-not-string.1
304  (let ((x "")) (values (substitute-if-not #\b (is-not-eql-p #\a) x) x))
305  "" "")
306
307(deftest substitute-if-not-string.2
308  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x) x))
309  "bbbc"
310  "abac")
311
312(deftest substitute-if-not-string.3
313  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count nil) x))
314  "bbbc"
315  "abac")
316
317(deftest substitute-if-not-string.4
318  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 2) x))
319  "bbbc"
320  "abac")
321
322(deftest substitute-if-not-string.5
323  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 1) x))
324  "bbac"
325  "abac")
326
327(deftest substitute-if-not-string.6
328  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 0) x))
329  "abac"
330  "abac")
331
332(deftest substitute-if-not-string.7
333  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count -1) x))
334  "abac"
335  "abac")
336
337(deftest substitute-if-not-string.8
338  (let ((x "")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t) x))
339  "" "")
340
341(deftest substitute-if-not-string.9
342  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t) x))
343  "bbbc"
344  "abac")
345
346(deftest substitute-if-not-string.10
347  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t :count nil) x))
348  "bbbc"
349  "abac")
350
351(deftest substitute-if-not-string.11
352  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 2 :from-end t) x))
353  "bbbc"
354  "abac")
355
356(deftest substitute-if-not-string.12
357  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 1 :from-end t) x))
358  "abbc"
359  "abac")
360
361(deftest substitute-if-not-string.13
362  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 0 :from-end t) x))
363  "abac"
364  "abac")
365
366(deftest substitute-if-not-string.14
367  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count -1 :from-end t) x))
368  "abac"
369  "abac")
370
371(deftest substitute-if-not-string.15
372  (loop for i from 0 to 9 always
373        (loop for j from i to 10 always
374              (let* ((orig "aaaaaaaaaa")
375                     (x (copy-seq orig))
376                     (y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j)))
377                (and (equalp orig x)
378                     (equalp y (concatenate 'simple-string
379                                           (make-array i :initial-element #\a)
380                                           (make-array (- j i) :initial-element #\x)
381                                           (make-array (- 10 j) :initial-element #\a)))))))
382  t)
383
384(deftest substitute-if-not-string.16
385  (loop for i from 0 to 9 always
386        (loop for j from i to 10 always
387              (let* ((orig "aaaaaaaaaa")
388                     (x (copy-seq orig))
389                     (y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :from-end t)))
390                (and (equalp orig x)
391                     (equalp y (concatenate 'simple-string
392                                           (make-array i :initial-element #\a)
393                                           (make-array (- j i) :initial-element #\x)
394                                           (make-array (- 10 j) :initial-element #\a)))))))
395  t)
396
397(deftest substitute-if-not-string.17
398  (loop for i from 0 to 9 always
399        (loop for j from i to 10 always
400              (loop for c from 0 to (- j i) always
401                    (let* ((orig "aaaaaaaaaa")
402                           (x (copy-seq orig))
403                           (y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c)))
404                      (and (equalp orig x)
405                           (equalp y (concatenate 'simple-string
406                                                 (make-array i :initial-element #\a)
407                                                 (make-array c :initial-element #\x)
408                                                 (make-array (- 10 (+ i c)) :initial-element #\a))))))))
409  t)
410
411(deftest substitute-if-not-string.18
412  (loop for i from 0 to 9 always
413        (loop for j from i to 10 always
414              (loop for c from 0 to (- j i) always
415                    (let* ((orig "aaaaaaaaaa")
416                           (x (copy-seq orig))
417                           (y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c :from-end t)))
418                      (and (equalp orig x)
419                           (equalp y (concatenate 'simple-string
420                                                 (make-array (- j c) :initial-element #\a)
421                                                 (make-array c :initial-element #\x)
422                                                 (make-array (- 10 j) :initial-element #\a))))))))
423  t)
424
425(deftest substitute-if-not-string.28
426  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
427                       :fill-pointer 5 :element-type 'character))
428         (result (substitute-if-not #\z (is-not-eql-p #\a) x)))
429    result)
430  "zbzcb")
431
432(deftest substitute-if-not-string.29
433  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
434                       :fill-pointer 5 :element-type 'character))
435         (result (substitute-if-not #\z (is-not-eql-p #\a) x :from-end t)))
436    result)
437  "zbzcb")
438
439(deftest substitute-if-not-string.30
440  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
441                       :fill-pointer 5 :element-type 'character))
442         (result (substitute-if-not #\z (is-not-eql-p #\a) x :count 1)))
443    result)
444  "zbacb")
445
446(deftest substitute-if-not-string.31
447  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
448                       :fill-pointer 5 :element-type 'character))
449         (result (substitute-if-not #\z (is-not-eql-p #\a) x
450                                    :from-end t :count 1)))
451    result)
452  "abzcb")
453
454
455
456;;; Tests on bitstrings
457
458(deftest substitute-if-not-bitstring.1
459  (let* ((orig #*)
460         (x (copy-seq orig))
461         (result (substitute-if-not 0 (is-not-eql-p 1) x)))
462    (and (equalp orig x)
463         result))
464  #*)
465
466(deftest substitute-if-not-bitstring.2
467  (let* ((orig #*)
468         (x (copy-seq orig))
469         (result (substitute-if-not 1 (complement #'zerop) x)))
470    (and (equalp orig x)
471         result))
472  #*)
473
474(deftest substitute-if-not-bitstring.3
475  (let* ((orig #*010101)
476         (x (copy-seq orig))
477         (result (substitute-if-not 0 (is-not-eql-p 1) x)))
478    (and (equalp orig x)
479         result))
480  #*000000)
481
482(deftest substitute-if-not-bitstring.4
483  (let* ((orig #*010101)
484         (x (copy-seq orig))
485         (result (substitute-if-not 1 (complement #'zerop) x)))
486    (and (equalp orig x)
487         result))
488  #*111111)
489
490(deftest substitute-if-not-bitstring.5
491  (let* ((orig #*010101)
492         (x (copy-seq orig))
493         (result (substitute-if-not 1 (complement #'zerop) x :start 1)))
494    (and (equalp orig x)
495         result))
496  #*011111)
497 
498(deftest substitute-if-not-bitstring.6
499  (let* ((orig #*010101)
500         (x (copy-seq orig))
501         (result (substitute-if-not 0 (is-not-eql-p 1) x :start 2 :end nil)))
502    (and (equalp orig x)
503         result))
504  #*010000)
505
506(deftest substitute-if-not-bitstring.7
507  (let* ((orig #*010101)
508         (x (copy-seq orig))
509         (result (substitute-if-not 1 (complement #'zerop) x :end 4)))
510    (and (equalp orig x)
511         result))
512  #*111101)
513 
514(deftest substitute-if-not-bitstring.8
515  (let* ((orig #*010101)
516         (x (copy-seq orig))
517         (result (substitute-if-not 0 (is-not-eql-p 1) x :end nil)))
518    (and (equalp orig x)
519         result))
520  #*000000)
521
522(deftest substitute-if-not-bitstring.9
523  (let* ((orig #*010101)
524         (x (copy-seq orig))
525         (result (substitute-if-not 0 (is-not-eql-p 1) x :end 3)))
526    (and (equalp orig x)
527         result))
528  #*000101)
529
530(deftest substitute-if-not-bitstring.10
531  (let* ((orig #*010101)
532         (x (copy-seq orig))
533         (result (substitute-if-not 0 (is-not-eql-p 1) x :start 2 :end 4)))
534    (and (equalp orig x)
535         result))
536  #*010001)
537
538(deftest substitute-if-not-bitstring.11
539  (let* ((orig #*010101)
540         (x (copy-seq orig))
541         (result (substitute-if-not 1 (complement #'zerop) x :start 2 :end 4)))
542    (and (equalp orig x)
543         result))
544  #*011101)
545
546(deftest substitute-if-not-bitstring.12
547  (let* ((orig #*010101)
548         (x (copy-seq orig))
549         (result (substitute-if-not 1 (complement #'zerop) x :count 1)))
550    (and (equalp orig x)
551         result))
552  #*110101)
553
554(deftest substitute-if-not-bitstring.13
555  (let* ((orig #*010101)
556         (x (copy-seq orig))
557         (result (substitute-if-not 1 (complement #'zerop) x :count 0)))
558    (and (equalp orig x)
559         result))
560  #*010101)
561
562(deftest substitute-if-not-bitstring.14
563  (let* ((orig #*010101)
564         (x (copy-seq orig))
565         (result (substitute-if-not 1 (complement #'zerop) x :count -1)))
566    (and (equalp orig x)
567         result))
568  #*010101)
569
570(deftest substitute-if-not-bitstring.15
571  (let* ((orig #*010101)
572         (x (copy-seq orig))
573         (result (substitute-if-not 1 (complement #'zerop) x :count 1 :from-end t)))
574    (and (equalp orig x)
575         result))
576  #*010111)
577
578(deftest substitute-if-not-bitstring.16
579  (let* ((orig #*010101)
580         (x (copy-seq orig))
581         (result (substitute-if-not 1 (complement #'zerop) x :count 0 :from-end t)))
582    (and (equalp orig x)
583         result))
584  #*010101)
585
586(deftest substitute-if-not-bitstring.17
587  (let* ((orig #*010101)
588         (x (copy-seq orig))
589         (result (substitute-if-not 1 (complement #'zerop) x :count -1 :from-end t)))
590    (and (equalp orig x)
591         result))
592  #*010101)
593
594(deftest substitute-if-not-bitstring.18
595  (let* ((orig #*010101)
596         (x (copy-seq orig))
597         (result (substitute-if-not 1 (complement #'zerop) x :count nil)))
598    (and (equalp orig x)
599         result))
600  #*111111)
601
602(deftest substitute-if-not-bitstring.19
603  (let* ((orig #*010101)
604         (x (copy-seq orig))
605         (result (substitute-if-not 1 (complement #'zerop) x :count nil :from-end t)))
606    (and (equalp orig x)
607         result))
608  #*111111)
609
610(deftest substitute-if-not-bitstring.20
611  (loop for i from 0 to 9 always
612        (loop for j from i to 10 always
613              (loop for c from 0 to (- j i) always
614                    (let* ((orig #*0000000000)
615                           (x (copy-seq orig))
616                           (y (substitute-if-not 1 (complement #'zerop) x :start i :end j :count c)))
617                      (and (equalp orig x)
618                           (equalp y (concatenate
619                                      'simple-bit-vector
620                                      (make-list i :initial-element 0)
621                                      (make-list c :initial-element 1)
622                                      (make-list (- 10 (+ i c)) :initial-element 0))))))))
623  t)
624
625(deftest substitute-if-not-bitstring.21
626  (loop for i from 0 to 9 always
627        (loop for j from i to 10 always
628              (loop for c from 0 to (- j i) always
629                    (let* ((orig #*1111111111)
630                           (x (copy-seq orig))
631                           (y (substitute-if-not 0 (is-not-eql-p 1) x :start i :end j :count c :from-end t)))
632                      (and (equalp orig x)
633                           (equalp y (concatenate
634                                      'simple-bit-vector
635                                      (make-list (- j c) :initial-element 1)
636                                      (make-list c :initial-element 0)
637                                      (make-list (- 10 j) :initial-element 1))))))))
638  t)
639
640;;; More tests
641
642(deftest substitute-if-not-list.24
643  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
644         (x (copy-seq orig))
645         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
646    (and (equal orig x)
647         result))
648  ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
649
650(deftest substitute-if-not-list.25
651  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
652         (x (copy-seq orig))
653         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x
654                                :key #'car :start 1 :end 5)))
655    (and (equal orig x)
656         result))
657  ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))
658
659(deftest substitute-if-not-vector.24
660  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
661         (x (copy-seq orig))
662         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
663    (and (equalp orig x)
664         result))
665  #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
666   
667(deftest substitute-if-not-vector.25
668  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
669         (x (copy-seq orig))
670         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car :start 1 :end 5)))
671    (and (equalp orig x)
672         result))
673  #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))
674
675(deftest substitute-if-not-string.24
676  (let* ((orig "0102342015")
677         (x (copy-seq orig))
678         (result (substitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit)))
679    (and (equalp orig x)
680         result))
681  "a1a2342a15")
682   
683(deftest substitute-if-not-string.25
684  (let* ((orig "0102342015")
685         (x (copy-seq orig))
686         (result (substitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit :start 1 :end 6)))
687    (and (equalp orig x)
688         result))
689  "01a2342015")
690
691(deftest substitute-if-not-string.26
692  (do-special-strings
693   (s "xyzabcxyzabc" nil)
694   (assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s) "xyz!bcxyz!bc"))
695   (assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1) "xyz!bcxyzabc"))
696   (assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc"))
697   (assert (string= s "xyzabcxyzabc")))
698  nil)
699
700(deftest substitute-if-not-bitstring.26
701  (let* ((orig #*00111001011010110)
702         (x (copy-seq orig))
703         (result (substitute-if-not 1 (is-not-eql-p 1) x :key #'1+)))
704    (and (equalp orig x)
705         result))
706  #*11111111111111111)
707   
708(deftest substitute-if-not-bitstring.27
709  (let* ((orig #*00111001011010110)
710         (x (copy-seq orig))
711         (result (substitute-if-not 1 (is-not-eql-p 1) x :key #'1+ :start 1 :end 10)))
712    (and (equalp orig x)
713         result))
714  #*01111111111010110)
715
716(deftest substitute-if-not-bit-vector.30
717  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
718                       :fill-pointer 5 :element-type 'bit))
719         (result (substitute-if-not 1 #'onep x)))
720    result)
721  #*11111)
722
723(deftest substitute-if-not-bit-vector.31
724  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
725                       :fill-pointer 5 :element-type 'bit))
726         (result (substitute-if-not 1 #'onep x :from-end t)))
727    result)
728  #*11111)
729
730(deftest substitute-if-not-bit-vector.32
731  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
732                       :fill-pointer 5 :element-type 'bit))
733         (result (substitute-if-not 1 #'onep x :count 1)))
734    result)
735  #*11011)
736
737(deftest substitute-if-not-bit-vector.33
738  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
739                       :fill-pointer 5 :element-type 'bit))
740         (result (substitute-if-not 1 #'onep x :from-end t :count 1)))
741    result)
742  #*01111)
743
744(deftest substitute-if-not.order.1
745  (let ((i 0) a b c d e f g h)
746    (values
747     (substitute-if-not
748      (progn (setf a (incf i)) 'a)
749      (progn (setf b (incf i)) #'identity)
750      (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
751      :count (progn (setf d (incf i)) 2)
752      :start (progn (setf e (incf i)) 0)
753      :end (progn (setf f (incf i)) 7)
754      :key (progn (setf g (incf i)) #'identity)
755      :from-end (setf h (incf i))
756      )
757     i a b c d e f g h))
758  (nil 1 2 a 3 4 a 5)
759  8 1 2 3 4 5 6 7 8)
760
761(deftest substitute-if-not.order.2
762  (let ((i 0) a b c d e f g h)
763    (values
764     (substitute-if-not
765      (progn (setf a (incf i)) 'a)
766      (progn (setf b (incf i)) #'identity)
767      (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
768      :from-end (setf h (incf i))
769      :key (progn (setf g (incf i)) #'identity)
770      :end (progn (setf f (incf i)) 7)
771      :start (progn (setf e (incf i)) 0)
772      :count (progn (setf d (incf i)) 2)
773      )
774     i a b c d e f g h))
775  (nil 1 2 a 3 4 a 5)
776  8 1 2 3 8 7 6 5 4)
777
778;;; Keyword tests
779
780(deftest substitute-if-not.allow-other-keys.1
781  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
782                      :allow-other-keys t :bad t)
783  (a a 0 a a 0 a))
784
785(deftest substitute-if-not.allow-other-keys.2
786  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
787                      :bad t :allow-other-keys t)
788  (a a 0 a a 0 a))
789
790(deftest substitute-if-not.allow-other-keys.3
791  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
792                  :allow-other-keys nil :bad t)
793  (a a 0 a a 0 a))
794
795(deftest substitute-if-not.allow-other-keys.4
796  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :bad t
797                  :allow-other-keys t :allow-other-keys nil)
798  (a a 0 a a 0 a))
799
800(deftest substitute-if-not.allow-other-keys.5
801  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
802                  :allow-other-keys t :key #'1-)
803  (1 a a a 1 a a))
804
805(deftest substitute-if-not.keywords.6
806  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
807                      :key #'1- :key #'identity)
808  (1 a a a 1 a a))
809
810(deftest substitute-if-not.allow-other-keys.7
811  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
812                  :bad t :allow-other-keys nil)
813  (a a 0 a a 0 a))
814
815(deftest substitute-if-not.allow-other-keys.8
816  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil)
817  (a a 0 a a 0 a))
818
819;;; Constant folding tests
820
821(def-fold-test substitute-if-not.fold.1
822  (substitute-if-not 'z 'identity '(a nil b)))
823(def-fold-test substitute-if-not.fold.2
824  (substitute-if-not 'z 'identity #(a nil b)))
825(def-fold-test substitute-if-not.fold.3
826  (substitute-if-not 0 'zerop #*100110))
827(def-fold-test substitute-if-not.fold.4
828  (substitute-if-not #\0 #'digit-char-p "asdaw82213nn1239123dd"))
829
830;;; Error cases
831
832(deftest substitute-if-not.error.1
833  (signals-error (substitute-if-not) program-error)
834  t)
835
836(deftest substitute-if-not.error.2
837  (signals-error (substitute-if-not 'a) program-error)
838  t)
839
840(deftest substitute-if-not.error.3
841  (signals-error (substitute-if-not 'a #'null) program-error)
842  t)
843
844(deftest substitute-if-not.error.4
845  (signals-error (substitute-if-not 'a #'null nil 'bad t) program-error)
846  t)
847
848(deftest substitute-if-not.error.5
849  (signals-error (substitute-if-not 'a #'null nil
850                                      'bad t :allow-other-keys nil) program-error)
851  t)
852
853(deftest substitute-if-not.error.6
854  (signals-error (substitute-if-not 'a #'null nil :key) program-error)
855  t)
856
857(deftest substitute-if-not.error.7
858  (signals-error (substitute-if-not 'a #'null nil 1 2) program-error)
859  t)
860
861(deftest substitute-if-not.error.8
862  (signals-error (substitute-if-not 'a #'cons (list 'a 'b 'c)) program-error)
863  t)
864
865(deftest substitute-if-not.error.9
866  (signals-error (substitute-if-not 'a #'car (list 'a 'b 'c)) type-error)
867  t)
868
869(deftest substitute-if-not.error.10
870  (signals-error (substitute-if-not 'a #'identity (list 'a 'b 'c)
871                                  :key #'car)
872                 type-error)
873  t)
874
875(deftest substitute-if-not.error.11
876  (signals-error (substitute-if-not 'a #'identity (list 'a 'b 'c)
877                                  :key #'cons)
878                 program-error)
879  t)
880
881(deftest substitute-if-not.error.12
882  (check-type-error #'(lambda (x) (substitute-if-not 'a #'not x)) #'sequencep)
883  nil)
Note: See TracBrowser for help on using the repository browser.