← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/substitute-if-not.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

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