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