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

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

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

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