source: trunk/source/tests/ansi-tests/substitute.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: 31.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Aug 28 21:15:33 2002
4;;;; Contains: Tests for SUBSTITUTE
5
6(in-package :cl-test)
7
8(deftest substitute-list.1
9  (let ((x '())) (values (substitute 'b 'a x) x))
10  nil nil)
11
12(deftest substitute-list.2
13  (let ((x '(a b a c))) (values (substitute 'b 'a x) x))
14  (b b b c)
15  (a b a c))
16
17(deftest substitute-list.3
18  (let ((x '(a b a c))) (values (substitute 'b 'a x :count nil) x))
19  (b b b c)
20  (a b a c))
21
22(deftest substitute-list.4
23  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 2) x))
24  (b b b c)
25  (a b a c))
26
27(deftest substitute-list.5
28  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 1) x))
29  (b b a c)
30  (a b a c))
31
32(deftest substitute-list.6
33  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 0) x))
34  (a b a c)
35  (a b a c))
36
37(deftest substitute-list.7
38  (let ((x '(a b a c))) (values (substitute 'b 'a x :count -1) x))
39  (a b a c)
40  (a b a c))
41
42(deftest substitute-list.8
43  (let ((x '())) (values (substitute 'b 'a x :from-end t) x))
44  nil nil)
45
46(deftest substitute-list.9
47  (let ((x '(a b a c))) (values (substitute 'b 'a x :from-end t) x))
48  (b b b c)
49  (a b a c))
50
51(deftest substitute-list.10
52  (let ((x '(a b a c))) (values (substitute 'b 'a x :from-end t :count nil) x))
53  (b b b c)
54  (a b a c))
55
56(deftest substitute-list.11
57  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 2 :from-end t) x))
58  (b b b c)
59  (a b a c))
60
61(deftest substitute-list.12
62  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 1 :from-end t) x))
63  (a b b c)
64  (a b a c))
65
66(deftest substitute-list.13
67  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 0 :from-end t) x))
68  (a b a c)
69  (a b a c))
70
71(deftest substitute-list.14
72  (let ((x '(a b a c))) (values (substitute 'b 'a x :count -1 :from-end t) x))
73  (a b a c)
74  (a b a c))
75
76(deftest substitute-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 'x '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-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 'x '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-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 'x '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-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 'x '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(deftest substitute-list.19
127  (let* ((orig '(1 2 3 4 5 6 7 8 9))
128         (x (copy-seq orig))
129         (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2)))))
130    (and (equal orig x)
131         result))
132  (1 2 x x x x x 8 9))
133
134(deftest substitute-list.20
135  (let* ((orig '(1 2 3 4 5 6 7 8 9))
136         (x (copy-seq orig))
137         (c -4)
138         (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a)))))
139    (and (equal orig x)
140         result))
141  (1 2 x 4 5 6 7 8 9))
142
143
144(deftest substitute-list.21
145  (let* ((orig '(1 2 3 4 5 6 7 8 9))
146         (x (copy-seq orig))
147         (c 5)
148         (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a))
149                             :from-end t)))
150    (and (equal orig x)
151         result))
152  (1 2 3 4 5 6 7 x 9))
153
154(deftest substitute-list.22
155  (let* ((orig '(1 2 3 4 5 6 7 8 9))
156         (x (copy-seq orig))
157         (c -4)
158         (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a)))))
159    (and (equal orig x)
160         result))
161  (1 2 x 4 5 6 7 8 9))
162
163
164(deftest substitute-list.23
165  (let* ((orig '(1 2 3 4 5 6 7 8 9))
166         (x (copy-seq orig))
167         (c 5)
168         (result (substitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a))
169                             :from-end t)))
170    (and (equal orig x)
171         result))
172  (1 2 3 4 5 6 7 x 9))
173
174(deftest substitute-list.24
175  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
176         (x (copy-seq orig))
177         (result (substitute '(a 10) 'a x :key #'car)))
178    (and (equal orig x)
179         result))
180  ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
181
182(deftest substitute-list.25
183  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
184         (x (copy-seq orig))
185         (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5)))
186    (and (equal orig x)
187         result))
188  ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))
189
190(deftest substitute-list.26
191  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
192         (x (copy-seq orig))
193         (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql))))
194    (and (equal orig x)
195         result))
196  ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))
197
198(deftest substitute-list.27
199  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
200         (x (copy-seq orig))
201         (result (substitute '(a 10) 'a x :key #'car :test-not #'eql)))
202    (and (equal orig x)
203         result))
204  ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))   
205
206;;; Tests on vectors
207
208(deftest substitute-vector.1
209  (let ((x #())) (values (substitute 'b 'a x) x))
210  #() #())
211
212(deftest substitute-vector.2
213  (let ((x #(a b a c))) (values (substitute 'b 'a x) x))
214  #(b b b c)
215  #(a b a c))
216
217(deftest substitute-vector.3
218  (let ((x #(a b a c))) (values (substitute 'b 'a x :count nil) x))
219  #(b b b c)
220  #(a b a c))
221
222(deftest substitute-vector.4
223  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 2) x))
224  #(b b b c)
225  #(a b a c))
226
227(deftest substitute-vector.5
228  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 1) x))
229  #(b b a c)
230  #(a b a c))
231
232(deftest substitute-vector.6
233  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 0) x))
234  #(a b a c)
235  #(a b a c))
236
237(deftest substitute-vector.7
238  (let ((x #(a b a c))) (values (substitute 'b 'a x :count -1) x))
239  #(a b a c)
240  #(a b a c))
241
242(deftest substitute-vector.8
243  (let ((x #())) (values (substitute 'b 'a x :from-end t) x))
244  #() #())
245
246(deftest substitute-vector.9
247  (let ((x #(a b a c))) (values (substitute 'b 'a x :from-end t) x))
248  #(b b b c)
249  #(a b a c))
250
251(deftest substitute-vector.10
252  (let ((x #(a b a c))) (values (substitute 'b 'a x :from-end t :count nil) x))
253  #(b b b c)
254  #(a b a c))
255
256(deftest substitute-vector.11
257  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 2 :from-end t) x))
258  #(b b b c)
259  #(a b a c))
260
261(deftest substitute-vector.12
262  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 1 :from-end t) x))
263  #(a b b c)
264  #(a b a c))
265
266(deftest substitute-vector.13
267  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 0 :from-end t) x))
268  #(a b a c)
269  #(a b a c))
270
271(deftest substitute-vector.14
272  (let ((x #(a b a c))) (values (substitute 'b 'a x :count -1 :from-end t) x))
273  #(a b a c)
274  #(a b a c))
275
276(deftest substitute-vector.15
277  (loop for i from 0 to 9 always
278        (loop for j from i to 10 always
279              (let* ((orig #(a a a a a a a a a a))
280                     (x (copy-seq orig))
281                     (y (substitute 'x 'a x :start i :end j)))
282                (and (equalp orig x)
283                     (equalp y (concatenate 'simple-vector
284                                           (make-array i :initial-element 'a)
285                                           (make-array (- j i) :initial-element 'x)
286                                           (make-array (- 10 j) :initial-element 'a)))))))
287  t)
288
289(deftest substitute-vector.16
290  (loop for i from 0 to 9 always
291        (loop for j from i to 10 always
292              (let* ((orig #(a a a a a a a a a a))
293                     (x (copy-seq orig))
294                     (y (substitute 'x 'a x :start i :end j :from-end t)))
295                (and (equalp orig x)
296                     (equalp y (concatenate 'simple-vector
297                                           (make-array i :initial-element 'a)
298                                           (make-array (- j i) :initial-element 'x)
299                                           (make-array (- 10 j) :initial-element 'a)))))))
300  t)
301
302(deftest substitute-vector.17
303  (loop for i from 0 to 9 always
304        (loop for j from i to 10 always
305              (loop for c from 0 to (- j i) always
306                    (let* ((orig #(a a a a a a a a a a))
307                           (x (copy-seq orig))
308                           (y (substitute 'x 'a x :start i :end j :count c)))
309                      (and (equalp orig x)
310                           (equalp y (concatenate 'simple-vector
311                                                 (make-array i :initial-element 'a)
312                                                 (make-array c :initial-element 'x)
313                                                 (make-array (- 10 (+ i c)) :initial-element 'a))))))))
314  t)
315
316(deftest substitute-vector.18
317  (loop for i from 0 to 9 always
318        (loop for j from i to 10 always
319              (loop for c from 0 to (- j i) always
320                    (let* ((orig #(a a a a a a a a a a))
321                           (x (copy-seq orig))
322                           (y (substitute 'x 'a x :start i :end j :count c :from-end t)))
323                      (and (equalp orig x)
324                           (equalp y (concatenate 'simple-vector
325                                                 (make-array (- j c) :initial-element 'a)
326                                                 (make-array c :initial-element 'x)
327                                                 (make-array (- 10 j) :initial-element 'a))))))))
328  t)
329
330(deftest substitute-vector.19
331  (let* ((orig #(1 2 3 4 5 6 7 8 9))
332         (x (copy-seq orig))
333         (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2)))))
334    (and (equalp orig x)
335         result))
336  #(1 2 x x x x x 8 9))
337
338(deftest substitute-vector.20
339  (let* ((orig #(1 2 3 4 5 6 7 8 9))
340         (x (copy-seq orig))
341         (c -4)
342         (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a)))))
343    (and (equalp orig x)
344         result))
345  #(1 2 x 4 5 6 7 8 9))
346
347
348(deftest substitute-vector.21
349  (let* ((orig #(1 2 3 4 5 6 7 8 9))
350         (x (copy-seq orig))
351         (c 5)
352         (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a))
353                             :from-end t)))
354    (and (equalp orig x)
355         result))
356  #(1 2 3 4 5 6 7 x 9))
357
358(deftest substitute-vector.22
359  (let* ((orig #(1 2 3 4 5 6 7 8 9))
360         (x (copy-seq orig))
361         (c -4)
362         (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a)))))
363    (and (equalp orig x)
364         result))
365  #(1 2 x 4 5 6 7 8 9))
366
367
368(deftest substitute-vector.23
369  (let* ((orig #(1 2 3 4 5 6 7 8 9))
370         (x (copy-seq orig))
371         (c 5)
372         (result (substitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a))
373                             :from-end t)))
374    (and (equalp orig x)
375         result))
376  #(1 2 3 4 5 6 7 x 9))
377
378(deftest substitute-vector.24
379  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
380         (x (copy-seq orig))
381         (result (substitute '(a 10) 'a x :key #'car)))
382    (and (equalp orig x)
383         result))
384  #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
385   
386(deftest substitute-vector.25
387  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
388         (x (copy-seq orig))
389         (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5)))
390    (and (equalp orig x)
391         result))
392  #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))
393
394(deftest substitute-vector.26
395  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
396         (x (copy-seq orig))
397         (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql))))
398    (and (equalp orig x)
399         result))
400  #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))
401
402(deftest substitute-vector.27
403  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
404         (x (copy-seq orig))
405         (result (substitute '(a 10) 'a x :key #'car :test-not #'eql)))
406    (and (equalp orig x)
407         result))
408  #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))
409
410(deftest substitute-vector.28
411  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
412                       :fill-pointer 5))
413         (result (substitute 'z 'a x)))
414    result)
415  #(z b z c b))
416
417(deftest substitute-vector.29
418  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
419                       :fill-pointer 5))
420         (result (substitute 'z 'a x :from-end t)))
421    result)
422  #(z b z c b))
423
424(deftest substitute-vector.30
425  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
426                       :fill-pointer 5))
427         (result (substitute 'z 'a x :count 1)))
428    result)
429  #(z b a c b))
430
431(deftest substitute-vector.31
432  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
433                       :fill-pointer 5))
434         (result (substitute 'z 'a x :from-end t :count 1)))
435    result)
436  #(a b z c b))
437
438(deftest substitute-vector.32
439  (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
440         (v2 (make-array '(8) :displaced-to v1
441                         :displaced-index-offset 3)))
442    (values
443     (substitute 'x 'c v2 :count 1)
444     v1))
445  #(d a b x d a b c)
446  #(a b c d a b c d a b c d a b c d))
447
448(deftest substitute-vector.33
449  (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
450         (v2 (make-array '(8) :displaced-to v1
451                         :displaced-index-offset 3)))
452    (values
453     (substitute 'x 'c v2 :count 1 :from-end t)
454     v1))
455  #(d a b c d a b x)
456  #(a b c d a b c d a b c d a b c d))
457
458;;; Tests on strings
459
460(deftest substitute-string.1
461  (let ((x "")) (values (substitute #\b #\a x) x))
462  "" "")
463
464(deftest substitute-string.2
465  (let ((x "abac")) (values (substitute #\b #\a x) x))
466  "bbbc"
467  "abac")
468
469(deftest substitute-string.3
470  (let ((x "abac")) (values (substitute #\b #\a x :count nil) x))
471  "bbbc"
472  "abac")
473
474(deftest substitute-string.4
475  (let ((x "abac")) (values (substitute #\b #\a x :count 2) x))
476  "bbbc"
477  "abac")
478
479(deftest substitute-string.5
480  (let ((x "abac")) (values (substitute #\b #\a x :count 1) x))
481  "bbac"
482  "abac")
483
484(deftest substitute-string.6
485  (let ((x "abac")) (values (substitute #\b #\a x :count 0) x))
486  "abac"
487  "abac")
488
489(deftest substitute-string.7
490  (let ((x "abac")) (values (substitute #\b #\a x :count -1) x))
491  "abac"
492  "abac")
493
494(deftest substitute-string.8
495  (let ((x "")) (values (substitute #\b #\a x :from-end t) x))
496  "" "")
497
498(deftest substitute-string.9
499  (let ((x "abac")) (values (substitute #\b #\a x :from-end t) x))
500  "bbbc"
501  "abac")
502
503(deftest substitute-string.10
504  (let ((x "abac")) (values (substitute #\b #\a x :from-end t :count nil) x))
505  "bbbc"
506  "abac")
507
508(deftest substitute-string.11
509  (let ((x "abac")) (values (substitute #\b #\a x :count 2 :from-end t) x))
510  "bbbc"
511  "abac")
512
513(deftest substitute-string.12
514  (let ((x "abac")) (values (substitute #\b #\a x :count 1 :from-end t) x))
515  "abbc"
516  "abac")
517
518(deftest substitute-string.13
519  (let ((x "abac")) (values (substitute #\b #\a x :count 0 :from-end t) x))
520  "abac"
521  "abac")
522
523(deftest substitute-string.14
524  (let ((x "abac")) (values (substitute #\b #\a x :count -1 :from-end t) x))
525  "abac"
526  "abac")
527
528(deftest substitute-string.15
529  (loop for i from 0 to 9 always
530        (loop for j from i to 10 always
531              (let* ((orig "aaaaaaaaaa")
532                     (x (copy-seq orig))
533                     (y (substitute #\x #\a x :start i :end j)))
534                (and (equalp orig x)
535                     (equalp y (concatenate 'simple-string
536                                           (make-array i :initial-element #\a)
537                                           (make-array (- j i) :initial-element #\x)
538                                           (make-array (- 10 j) :initial-element #\a)))))))
539  t)
540
541(deftest substitute-string.16
542  (loop for i from 0 to 9 always
543        (loop for j from i to 10 always
544              (let* ((orig "aaaaaaaaaa")
545                     (x (copy-seq orig))
546                     (y (substitute #\x #\a x :start i :end j :from-end t)))
547                (and (equalp orig x)
548                     (equalp y (concatenate 'simple-string
549                                           (make-array i :initial-element #\a)
550                                           (make-array (- j i) :initial-element #\x)
551                                           (make-array (- 10 j) :initial-element #\a)))))))
552  t)
553
554(deftest substitute-string.17
555  (loop for i from 0 to 9 always
556        (loop for j from i to 10 always
557              (loop for c from 0 to (- j i) always
558                    (let* ((orig "aaaaaaaaaa")
559                           (x (copy-seq orig))
560                           (y (substitute #\x #\a x :start i :end j :count c)))
561                      (and (equalp orig x)
562                           (equalp y (concatenate 'simple-string
563                                                 (make-array i :initial-element #\a)
564                                                 (make-array c :initial-element #\x)
565                                                 (make-array (- 10 (+ i c)) :initial-element #\a))))))))
566  t)
567
568(deftest substitute-string.18
569  (loop for i from 0 to 9 always
570        (loop for j from i to 10 always
571              (loop for c from 0 to (- j i) always
572                    (let* ((orig "aaaaaaaaaa")
573                           (x (copy-seq orig))
574                           (y (substitute #\x #\a x :start i :end j :count c :from-end t)))
575                      (and (equalp orig x)
576                           (equalp y (concatenate 'simple-string
577                                                 (make-array (- j c) :initial-element #\a)
578                                                 (make-array c :initial-element #\x)
579                                                 (make-array (- 10 j) :initial-element #\a))))))))
580  t)
581
582(deftest substitute-string.19
583  (let* ((orig "123456789")
584         (x (copy-seq orig))
585         (result (substitute #\x #\5 x :test #'(lambda (a b)   
586                                                 (setq a (read-from-string (string a)))
587                                                 (setq b (read-from-string (string b)))
588                                                 (<= (abs (- a b)) 2)))))
589    (and (equalp orig x)
590         result))
591  "12xxxxx89")
592
593(deftest substitute-string.20
594  (let* ((orig "123456789")
595         (x (copy-seq orig))
596         (c -4)
597         (result (substitute #\x #\5 x :test #'(lambda (a b)
598                                                 (setq a (read-from-string (string a)))
599                                                 (setq b (read-from-string (string b)))
600                                                 (incf c 2) (= (+ b c) a)))))
601    (and (equalp orig x)
602         result))
603  "12x456789")
604
605
606(deftest substitute-string.21
607  (let* ((orig "123456789")
608         (x (copy-seq orig))
609         (c 5)
610         (result (substitute #\x #\9 x :test #'(lambda (a b)
611                                                 (setq a (read-from-string (string a)))
612                                                 (setq b (read-from-string (string b)))
613                                                 (incf c -2) (= (+ b c) a))
614                             :from-end t)))
615    (and (equalp orig x)
616         result))
617  "1234567x9")
618
619(deftest substitute-string.22
620  (let* ((orig "123456789")
621         (x (copy-seq orig))
622         (c -4)
623         (result (substitute #\x #\5 x :test-not #'(lambda (a b)
624                                                     (setq a (read-from-string (string a)))
625                                                     (setq b (read-from-string (string b)))
626                                                     (incf c 2) (/= (+ b c) a)))))
627    (and (equalp orig x)
628         result))
629  "12x456789")
630
631
632(deftest substitute-string.23
633  (let* ((orig "123456789")
634         (x (copy-seq orig))
635         (c 5)
636         (result (substitute #\x #\9 x :test-not #'(lambda (a b)
637                                                     (setq a (read-from-string (string a)))
638                                                     (setq b (read-from-string (string b)))
639                                                     (incf c -2) (/= (+ b c) a))
640                             :from-end t)))
641    (and (equalp orig x)
642         result))
643  "1234567x9")
644
645(deftest substitute-string.24
646  (let* ((orig "0102342015")
647         (x (copy-seq orig))
648         (result (substitute #\a #\1 x :key #'nextdigit)))
649    (and (equalp orig x)
650         result))
651  "a1a2342a15")
652   
653(deftest substitute-string.25
654  (let* ((orig "0102342015")
655         (x (copy-seq orig))
656         (result (substitute #\a #\1 x :key #'nextdigit :start 1 :end 6)))
657    (and (equalp orig x)
658         result))
659  "01a2342015")
660
661(deftest substitute-string.26
662  (let* ((orig "0102342015")
663         (x (copy-seq orig))
664         (result (substitute #\a #\1 x :key #'nextdigit :test (complement #'eql))))
665    (and (equalp orig x)
666         result))
667  "0a0aaaa0aa")
668
669(deftest substitute-string.27
670  (let* ((orig "0102342015")
671         (x (copy-seq orig))
672         (result (substitute #\a #\1 x :key #'nextdigit :test-not #'eql)))
673    (and (equalp orig x)
674         result))
675   "0a0aaaa0aa")
676
677(deftest substitute-string.28
678  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
679                       :fill-pointer 5 :element-type 'character))
680         (result (substitute #\z #\a x)))
681    result)
682  "zbzcb")
683
684(deftest substitute-string.29
685  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
686                       :fill-pointer 5 :element-type 'character))
687         (result (substitute #\z #\a x :from-end t)))
688    result)
689  "zbzcb")
690
691(deftest substitute-string.30
692  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
693                       :fill-pointer 5 :element-type 'character))
694         (result (substitute #\z #\a x :count 1)))
695    result)
696  "zbacb")
697
698(deftest substitute-string.31
699  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
700                       :fill-pointer 5 :element-type 'character))
701         (result (substitute #\z #\a x :from-end t :count 1)))
702    result)
703  "abzcb")
704
705(deftest substitute-string.32
706  (do-special-strings
707   (s "xyzabcxyzabc" nil)
708   (assert (string= (substitute #\! #\a s) "xyz!bcxyz!bc"))
709   (assert (string= (substitute #\! #\a s :count 1) "xyz!bcxyzabc"))
710   (assert (string= (substitute #\! #\a s :count 1 :from-end t) "xyzabcxyz!bc"))
711   (assert (string= s "xyzabcxyzabc")))
712  nil)
713
714;;; Tests on bit-vectors
715
716(deftest substitute-bit-vector.1
717  (let* ((orig #*)
718         (x (copy-seq orig))
719         (result (substitute 0 1 x)))
720    (and (equalp orig x)
721         result))
722  #*)
723
724(deftest substitute-bit-vector.2
725  (let* ((orig #*)
726         (x (copy-seq orig))
727         (result (substitute 1 0 x)))
728    (and (equalp orig x)
729         result))
730  #*)
731
732(deftest substitute-bit-vector.3
733  (let* ((orig #*010101)
734         (x (copy-seq orig))
735         (result (substitute 0 1 x)))
736    (and (equalp orig x)
737         result))
738  #*000000)
739
740(deftest substitute-bit-vector.4
741  (let* ((orig #*010101)
742         (x (copy-seq orig))
743         (result (substitute 1 0 x)))
744    (and (equalp orig x)
745         result))
746  #*111111)
747
748(deftest substitute-bit-vector.5
749  (let* ((orig #*010101)
750         (x (copy-seq orig))
751         (result (substitute 1 0 x :start 1)))
752    (and (equalp orig x)
753         result))
754  #*011111)
755 
756(deftest substitute-bit-vector.6
757  (let* ((orig #*010101)
758         (x (copy-seq orig))
759         (result (substitute 0 1 x :start 2 :end nil)))
760    (and (equalp orig x)
761         result))
762  #*010000)
763
764(deftest substitute-bit-vector.7
765  (let* ((orig #*010101)
766         (x (copy-seq orig))
767         (result (substitute 1 0 x :end 4)))
768    (and (equalp orig x)
769         result))
770  #*111101)
771 
772(deftest substitute-bit-vector.8
773  (let* ((orig #*010101)
774         (x (copy-seq orig))
775         (result (substitute 0 1 x :end nil)))
776    (and (equalp orig x)
777         result))
778  #*000000)
779
780(deftest substitute-bit-vector.9
781  (let* ((orig #*010101)
782         (x (copy-seq orig))
783         (result (substitute 0 1 x :end 3)))
784    (and (equalp orig x)
785         result))
786  #*000101)
787
788(deftest substitute-bit-vector.10
789  (let* ((orig #*010101)
790         (x (copy-seq orig))
791         (result (substitute 0 1 x :start 2 :end 4)))
792    (and (equalp orig x)
793         result))
794  #*010001)
795
796(deftest substitute-bit-vector.11
797  (let* ((orig #*010101)
798         (x (copy-seq orig))
799         (result (substitute 1 0 x :start 2 :end 4)))
800    (and (equalp orig x)
801         result))
802  #*011101)
803
804(deftest substitute-bit-vector.12
805  (let* ((orig #*010101)
806         (x (copy-seq orig))
807         (result (substitute 1 0 x :count 1)))
808    (and (equalp orig x)
809         result))
810  #*110101)
811
812(deftest substitute-bit-vector.13
813  (let* ((orig #*010101)
814         (x (copy-seq orig))
815         (result (substitute 1 0 x :count 0)))
816    (and (equalp orig x)
817         result))
818  #*010101)
819
820(deftest substitute-bit-vector.14
821  (let* ((orig #*010101)
822         (x (copy-seq orig))
823         (result (substitute 1 0 x :count -1)))
824    (and (equalp orig x)
825         result))
826  #*010101)
827
828(deftest substitute-bit-vector.15
829  (let* ((orig #*010101)
830         (x (copy-seq orig))
831         (result (substitute 1 0 x :count 1 :from-end t)))
832    (and (equalp orig x)
833         result))
834  #*010111)
835
836(deftest substitute-bit-vector.16
837  (let* ((orig #*010101)
838         (x (copy-seq orig))
839         (result (substitute 1 0 x :count 0 :from-end t)))
840    (and (equalp orig x)
841         result))
842  #*010101)
843
844(deftest substitute-bit-vector.17
845  (let* ((orig #*010101)
846         (x (copy-seq orig))
847         (result (substitute 1 0 x :count -1 :from-end t)))
848    (and (equalp orig x)
849         result))
850  #*010101)
851
852(deftest substitute-bit-vector.18
853  (let* ((orig #*010101)
854         (x (copy-seq orig))
855         (result (substitute 1 0 x :count nil)))
856    (and (equalp orig x)
857         result))
858  #*111111)
859
860(deftest substitute-bit-vector.19
861  (let* ((orig #*010101)
862         (x (copy-seq orig))
863         (result (substitute 1 0 x :count nil :from-end t)))
864    (and (equalp orig x)
865         result))
866  #*111111)
867
868(deftest substitute-bit-vector.20
869  (loop for i from 0 to 9 always
870        (loop for j from i to 10 always
871              (loop for c from 0 to (- j i) always
872                    (let* ((orig #*0000000000)
873                           (x (copy-seq orig))
874                           (y (substitute 1 0 x :start i :end j :count c)))
875                      (and (equalp orig x)
876                           (equalp y (concatenate
877                                      'simple-bit-vector
878                                      (make-list i :initial-element 0)
879                                      (make-list c :initial-element 1)
880                                      (make-list (- 10 (+ i c)) :initial-element 0))))))))
881  t)
882
883(deftest substitute-bit-vector.21
884  (loop for i from 0 to 9 always
885        (loop for j from i to 10 always
886              (loop for c from 0 to (- j i) always
887                    (let* ((orig #*1111111111)
888                           (x (copy-seq orig))
889                           (y (substitute 0 1 x :start i :end j :count c :from-end t)))
890                      (and (equalp orig x)
891                           (equalp y (concatenate
892                                      'simple-bit-vector
893                                      (make-list (- j c) :initial-element 1)
894                                      (make-list c :initial-element 0)
895                                      (make-list (- 10 j) :initial-element 1))))))))
896  t)
897
898(deftest substitute-bit-vector.22
899  (let* ((orig #*0101010101)
900         (x (copy-seq orig))
901         (c 0)
902         (result (substitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b))))))
903    (and (equalp orig x)
904         result))
905  #*0111110101)
906
907(deftest substitute-bit-vector.23
908  (let* ((orig #*0101010101)
909         (x (copy-seq orig))
910         (c 0)
911         (result (substitute 1 0 x :test-not #'(lambda (a b) (incf c)
912                                                 (not (and (<= 2 c 5) (= a b)))))))
913    (and (equalp orig x)
914         result))
915  #*0111110101)
916
917(deftest substitute-bit-vector.24
918  (let* ((orig #*0101010101)
919         (x (copy-seq orig))
920         (c 0)
921         (result (substitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b)))
922                             :from-end t)))
923    (and (equalp orig x)
924         result))
925  #*0101011111)
926
927(deftest substitute-bit-vector.25
928  (let* ((orig #*0101010101)
929         (x (copy-seq orig))
930         (c 0)
931         (result (substitute 1 0 x :test-not #'(lambda (a b) (incf c)
932                                                 (not (and (<= 2 c 5) (= a b))))
933                             :from-end t)))
934    (and (equalp orig x)
935         result))
936  #*0101011111)
937
938(deftest substitute-bit-vector.26
939  (let* ((orig #*00111001011010110)
940         (x (copy-seq orig))
941         (result (substitute 1 1 x :key #'1+)))
942    (and (equalp orig x)
943         result))
944  #*11111111111111111)
945   
946(deftest substitute-bit-vector.27
947  (let* ((orig #*00111001011010110)
948         (x (copy-seq orig))
949         (result (substitute 1 1 x :key #'1+ :start 1 :end 10)))
950    (and (equalp orig x)
951         result))
952  #*01111111111010110)
953
954(deftest substitute-bit-vector.28
955  (let* ((orig #*00111001011010110)
956         (x (copy-seq orig))
957         (result (substitute 0 1 x :key #'1+ :test (complement #'eql))))
958    (and (equalp orig x)
959         result))
960  #*00000000000000000)
961
962(deftest substitute-bit-vector.29
963  (let* ((orig #*00111001011010110)
964         (x (copy-seq orig))
965         (result (substitute 0 1 x :key #'1+ :test-not #'eql)))
966    (and (equalp orig x)
967         result))
968  #*00000000000000000)
969
970(deftest substitute-bit-vector.30
971  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
972                       :fill-pointer 5 :element-type 'bit))
973         (result (substitute 1 0 x)))
974    result)
975  #*11111)
976
977(deftest substitute-bit-vector.31
978  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
979                       :fill-pointer 5 :element-type 'bit))
980         (result (substitute 1 0 x :from-end t)))
981    result)
982  #*11111)
983
984(deftest substitute-bit-vector.32
985  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
986                       :fill-pointer 5 :element-type 'bit))
987         (result (substitute 1 0 x :count 1)))
988    result)
989  #*11011)
990
991(deftest substitute-bit-vector.33
992  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
993                       :fill-pointer 5 :element-type 'bit))
994         (result (substitute 1 0 x :from-end t :count 1)))
995    result)
996  #*01111)
997
998(defharmless substitute.test-and-test-not.1
999  (substitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql))
1000
1001(defharmless substitute.test-and-test-not.2
1002  (substitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql))
1003
1004(defharmless substitute.test-and-test-not.3
1005  (substitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql))
1006
1007(defharmless substitute.test-and-test-not.4
1008  (substitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql))
1009
1010(defharmless substitute.test-and-test-not.5
1011  (substitute #\b #\a (copy-seq "abcdab") :test #'eql :test-not #'eql))
1012
1013(defharmless substitute.test-and-test-not.6
1014  (substitute #\b #\a (copy-seq "abcdab") :test-not #'eql :test #'eql))
1015
1016(defharmless substitute.test-and-test-not.7
1017  (substitute 1 0 (copy-seq #*001101001) :test #'eql :test-not #'eql))
1018
1019(defharmless substitute.test-and-test-not.8
1020  (substitute 0 1 (copy-seq #*1100110101) :test-not #'eql :test #'eql))
1021
1022
1023(deftest substitute.order.1
1024  (let ((i 0) a b c d e f g h)
1025    (values
1026     (substitute
1027      (progn (setf a (incf i)) 'a)
1028      (progn (setf b (incf i)) nil)
1029      (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
1030      :count (progn (setf d (incf i)) 2)
1031      :start (progn (setf e (incf i)) 0)
1032      :end (progn (setf f (incf i)) 7)
1033      :key (progn (setf g (incf i)) #'identity)
1034      :from-end (setf h (incf i))
1035      )
1036     i a b c d e f g h))
1037  (nil 1 2 a 3 4 a 5)
1038  8 1 2 3 4 5 6 7 8)
1039
1040(deftest substitute.order.2
1041  (let ((i 0) a b c d e f g h)
1042    (values
1043     (substitute
1044      (progn (setf a (incf i)) 'a)
1045      (progn (setf b (incf i)) nil)
1046      (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
1047      :from-end (setf h (incf i))
1048      :key (progn (setf g (incf i)) #'identity)
1049      :end (progn (setf f (incf i)) 7)
1050      :start (progn (setf e (incf i)) 0)
1051      :count (progn (setf d (incf i)) 2)
1052      )
1053     i a b c d e f g h))
1054  (nil 1 2 a 3 4 a 5)
1055  8 1 2 3 8 7 6 5 4)
1056
1057;;; Keyword tests
1058
1059(deftest substitute.allow-other-keys.1
1060  (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t :bad t)
1061  (1 2 a 3 1 a 3))
1062
1063(deftest substitute.allow-other-keys.2
1064  (substitute 'a 0 (list 1 2 0 3 1 0 3) :bad t :allow-other-keys t)
1065  (1 2 a 3 1 a 3))
1066
1067(deftest substitute.allow-other-keys.3
1068  (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t
1069                  :allow-other-keys nil :bad t)
1070  (1 2 a 3 1 a 3))
1071
1072(deftest substitute.allow-other-keys.4
1073  (substitute 'a 0 (list 1 2 0 3 1 0 3) :bad t
1074                  :allow-other-keys t :allow-other-keys nil)
1075  (1 2 a 3 1 a 3))
1076
1077(deftest substitute.allow-other-keys.5
1078  (substitute 'a 0 (list 1 2 0 3 1 0 3)
1079                  :allow-other-keys t :key #'1-)
1080  (a 2 0 3 a 0 3))
1081
1082(deftest substitute.keywords.6
1083  (substitute 'a 0 (list 1 2 0 3 1 0 3) :key #'1- :key #'identity)
1084  (a 2 0 3 a 0 3))
1085
1086(deftest substitute.allow-other-keys.7
1087  (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t
1088                  :bad t :allow-other-keys nil)
1089  (1 2 a 3 1 a 3))
1090
1091(deftest substitute.allow-other-keys.8
1092  (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys nil)
1093  (1 2 a 3 1 a 3))
1094
1095;;; Constant folding tests
1096
1097(def-fold-test substitute.fold.1 (substitute 'z 'b '(a b c)))
1098(def-fold-test substitute.fold.2 (substitute 'z 'b #(a b c)))
1099(def-fold-test substitute.fold.3 (substitute 0 1 #*001101))
1100(def-fold-test substitute.fold.4 (substitute #\a #\b "abcebadfke"))
1101
1102;;; Error cases
1103
1104(deftest substitute.error.1
1105  (signals-error (substitute) program-error)
1106  t)
1107
1108(deftest substitute.error.2
1109  (signals-error (substitute 'a) program-error)
1110  t)
1111
1112(deftest substitute.error.3
1113  (signals-error (substitute 'a 'b) program-error)
1114  t)
1115
1116(deftest substitute.error.4
1117  (signals-error (substitute 'a 'b nil 'bad t) program-error)
1118  t)
1119
1120(deftest substitute.error.5
1121  (signals-error (substitute 'a 'b nil 'bad t :allow-other-keys nil) program-error)
1122  t)
1123
1124(deftest substitute.error.6
1125  (signals-error (substitute 'a 'b nil :key) program-error)
1126  t)
1127
1128(deftest substitute.error.7
1129  (signals-error (substitute 'a 'b nil 1 2) program-error)
1130  t)
1131
1132(deftest substitute.error.8
1133  (signals-error (substitute 'a 'b (list 'a 'b 'c) :test #'identity) program-error)
1134  t)
1135
1136(deftest substitute.error.9
1137  (signals-error (substitute 'a 'b (list 'a 'b 'c) :test-not #'identity) program-error)
1138  t)
1139
1140(deftest substitute.error.10
1141  (signals-error (substitute 'a 'b (list 'a 'b 'c) :key #'cons) program-error)
1142  t)
1143
1144(deftest substitute.error.11
1145  (signals-error (substitute 'a 'b (list 'a 'b 'c) :key #'car) type-error)
1146  t)
1147
1148(deftest substitute.error.12
1149  (check-type-error #'(lambda (x) (substitute 'a 'b x)) #'sequencep)
1150  nil)
Note: See TracBrowser for help on using the repository browser.