source: trunk/source/tests/ansi-tests/nsubstitute-if.lsp @ 8991

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

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

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