nsubstitute-if-not.lsp 28.1 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Aug 31 19:00:55 2002
;;;; Contains: Tests for NSUBSTITUTE-IF-NOT

(in-package :cl-test)

(deftest nsubstitute-if-not-list.1
  (nsubstitute-if-not 'b 'identity nil)
  nil)

(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 15 16
  (b b b c))

(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 19 20
  (b b b c))

(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 23 24
  (b b b c))

(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 27 28
  (b b a c))

(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 31 32
  (a b a c))

(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 35 36
  (a b a c))

(deftest nsubstitute-if-not-list.8
37
  (nsubstitute-if-not 'b (is-not-eql-p 'a) nil :from-end t)
38 39 40
  nil)

(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 43 44
  (b b b c))

(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 47 48
  (b b b c))

(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 51 52
  (b b b c))

(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 55 56
  (a b b c))

(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 59 60
  (a b a c))

(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 63 64 65
  (a b a c))

(deftest nsubstitute-if-not-list.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
66 67 68 69 70 71 72
        (loop for j from i to 10 always
              (let* ((orig '(a a a a a a a a a a))
                     (x (copy-seq orig))
                     (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
                (equal y (nconc (make-list i :initial-element 'a)
                                (make-list (- j i) :initial-element 'x)
                                (make-list (- 10 j) :initial-element 'a))))))
73 74 75 76
  t)

(deftest nsubstitute-if-not-list.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
77 78 79 80 81 82 83
        (loop for j from i to 10 always
              (let* ((orig '(a a a a a a a a a a))
                     (x (copy-seq orig))
                     (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
                (equal y (nconc (make-list i :initial-element 'a)
                                (make-list (- j i) :initial-element 'x)
                                (make-list (- 10 j) :initial-element 'a))))))
84 85 86 87
  t)

(deftest nsubstitute-if-not-list.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
88 89 90 91 92 93 94 95
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig '(a a a a a a a a a a))
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
                      (equal y (nconc (make-list i :initial-element 'a)
                                      (make-list c :initial-element 'x)
                                      (make-list (- 10 (+ i c)) :initial-element 'a)))))))
96 97 98 99
  t)

(deftest nsubstitute-if-not-list.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
100 101 102 103 104 105 106 107
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig '(a a a a a a a a a a))
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
                      (equal y (nconc (make-list (- j c) :initial-element 'a)
                                      (make-list c :initial-element 'x)
                                      (make-list (- 10 j) :initial-element 'a)))))))
108 109 110 111 112
  t)

;;; Tests on vectors

(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 119 120
  #(b b b c))

(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 123 124
  #(b b b c))

(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 127 128
  #(b b b c))

(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 131 132
  #(b b a c))

(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 135 136
  #(a b a c))

(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 139 140
  #(a b a c))

(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 147 148
  #(b b b c))

(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 151 152
  #(b b b c))

(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 155 156
  #(b b b c))

(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 159 160
  #(a b b c))

(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 163 164
  #(a b a c))

(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 167 168 169
  #(a b a c))

(deftest nsubstitute-if-not-vector.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
170 171 172 173 174 175 176 177
        (loop for j from i to 10 always
              (let* ((orig #(a a a a a a a a a a))
                     (x (copy-seq orig))
                     (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
                (equalp y (concatenate 'simple-vector
                                       (make-array i :initial-element 'a)
                                       (make-array (- j i) :initial-element 'x)
                                       (make-array (- 10 j) :initial-element 'a))))))
178 179 180 181
  t)

(deftest nsubstitute-if-not-vector.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
182 183 184 185 186 187 188 189
        (loop for j from i to 10 always
              (let* ((orig #(a a a a a a a a a a))
                     (x (copy-seq orig))
                     (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
                (equalp y (concatenate 'simple-vector
                                       (make-array i :initial-element 'a)
                                       (make-array (- j i) :initial-element 'x)
                                       (make-array (- 10 j) :initial-element 'a))))))
190 191 192 193
  t)

(deftest nsubstitute-if-not-vector.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
194 195 196 197 198 199 200 201 202
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig #(a a a a a a a a a a))
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
                      (equalp y (concatenate 'simple-vector
                                             (make-array i :initial-element 'a)
                                             (make-array c :initial-element 'x)
                                             (make-array (- 10 (+ i c)) :initial-element 'a)))))))
203 204 205 206
  t)

(deftest nsubstitute-if-not-vector.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
207 208 209 210 211 212 213 214 215
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig #(a a a a a a a a a a))
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
                      (equalp y (concatenate 'simple-vector
                                             (make-array (- j c) :initial-element 'a)
                                             (make-array c :initial-element 'x)
                                             (make-array (- 10 j) :initial-element 'a)))))))
216 217
  t)

218 219
(deftest nsubstitute-if-not-vector.28
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
220 221
                       :fill-pointer 5))
         (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x)))
222 223 224 225 226
    result)
  #(z b z c b))

(deftest nsubstitute-if-not-vector.29
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
227 228
                       :fill-pointer 5))
         (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x :from-end t)))
229 230 231 232 233
    result)
  #(z b z c b))

(deftest nsubstitute-if-not-vector.30
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
234 235
                       :fill-pointer 5))
         (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x :count 1)))
236 237 238 239 240
    result)
  #(z b a c b))

(deftest nsubstitute-if-not-vector.31
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
241 242 243
                       :fill-pointer 5))
         (result (nsubstitute-if-not 'z (is-not-eql-p 'a) x
                                    :from-end t :count 1)))
244 245 246
    result)
  #(a b z c b))

247 248
(deftest nsubstitute-if-not-vector.32
  (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
sds's avatar
sds committed
249 250
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
251 252 253 254 255
    (nsubstitute-if-not 'x (is-not-eql-p 'c) v2 :count 1))
  #(d a b x d a b c))

(deftest nsubstitute-if-not-vector.33
  (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
sds's avatar
sds committed
256 257
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
258 259 260
    (nsubstitute-if-not 'x (is-not-eql-p 'c) v2 :count 1 :from-end t))
  #(d a b c d a b x))

261 262 263
;;; Tests on strings

(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 270 271
  "bbbc")

(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 274 275
  "bbbc")

(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 278 279
  "bbbc")

(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 282 283
  "bbac")

(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 286 287
  "abac")

(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 290 291
  "abac")

(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 298 299
  "bbbc")

(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 302 303
  "bbbc")

(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 306 307
  "bbbc")

(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 310 311
  "abbc")

(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 314 315
  "abac")

(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 318 319 320
  "abac")

(deftest nsubstitute-if-not-string.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
321 322 323 324 325 326 327 328
        (loop for j from i to 10 always
              (let* ((orig "aaaaaaaaaa")
                     (x (copy-seq orig))
                     (y (nsubstitute-if-not #\x (is-not-eql-p #\a) x :start i :end j)))
                (equalp y (concatenate 'simple-string
                                       (make-array i :initial-element #\a)
                                       (make-array (- j i) :initial-element #\x)
                                       (make-array (- 10 j) :initial-element #\a))))))
329 330 331 332
  t)

(deftest nsubstitute-if-not-string.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
333 334 335 336 337 338 339 340
        (loop for j from i to 10 always
              (let* ((orig "aaaaaaaaaa")
                     (x (copy-seq orig))
                     (y (nsubstitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :from-end t)))
                (equalp y (concatenate 'simple-string
                                       (make-array i :initial-element #\a)
                                       (make-array (- j i) :initial-element #\x)
                                       (make-array (- 10 j) :initial-element #\a))))))
341 342 343 344
  t)

(deftest nsubstitute-if-not-string.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
345 346 347 348 349 350 351 352 353
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig "aaaaaaaaaa")
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c)))
                      (equalp y (concatenate 'simple-string
                                             (make-array i :initial-element #\a)
                                             (make-array c :initial-element #\x)
                                             (make-array (- 10 (+ i c)) :initial-element #\a)))))))
354 355 356 357
  t)

(deftest nsubstitute-if-not-string.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
358 359 360 361 362 363 364 365 366
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig "aaaaaaaaaa")
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c :from-end t)))
                      (equalp y (concatenate 'simple-string
                                             (make-array (- j c) :initial-element #\a)
                                             (make-array c :initial-element #\x)
                                             (make-array (- 10 j) :initial-element #\a)))))))
367 368
  t)

369
(deftest nsubstitute-if-not-string.28
370
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
371 372
                       :fill-pointer 5 :element-type 'character))
         (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x)))
373 374 375 376
    result)
  "zbzcb")

(deftest nsubstitute-if-not-string.29
377
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
378 379
                       :fill-pointer 5 :element-type 'character))
         (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x :from-end t)))
380 381 382 383
    result)
  "zbzcb")

(deftest nsubstitute-if-not-string.30
384
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
385 386
                       :fill-pointer 5 :element-type 'character))
         (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x :count 1)))
387 388
    result)
  "zbacb")
389

390
(deftest nsubstitute-if-not-string.31
391
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
392 393 394
                       :fill-pointer 5 :element-type 'character))
         (result (nsubstitute-if-not #\z (is-not-eql-p #\a) x
                                    :from-end t :count 1)))
395 396 397
    result)
  "abzcb")

398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415
(deftest nsubstitute-if-not-string.32
  (do-special-strings
   (s "xyzabcxyzabc" nil)
   (assert (string= (nsubstitute-if-not #\! (is-not-eql-p #\a) s) "xyz!bcxyz!bc")))
  nil)

(deftest nsubstitute-if-not-string.33
  (do-special-strings
   (s "xyzabcxyzabc" nil)
   (assert (string= (nsubstitute-if-not #\! (is-not-eql-p #\a) s :count 1) "xyz!bcxyzabc")))
  nil)

(deftest nsubstitute-if-not-string.34
  (do-special-strings
   (s "xyzabcxyzabc" nil)
   (assert (string= (nsubstitute-if-not #\! (is-not-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc")))
  nil)

416 417 418 419

;;; Tests on bit-vectors

(deftest nsubstitute-if-not-bit-vector.1
420
  (let* ((orig #*)
sds's avatar
sds committed
421 422
         (x (copy-seq orig))
         (result (nsubstitute-if-not 0 (is-not-eql-p 1) x)))
423 424 425
    result)
  #*)

426
(deftest nsubstitute-if-not-bit-vector.2
427
  (let* ((orig #*)
sds's avatar
sds committed
428 429
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x)))
430 431 432
    result)
  #*)

433
(deftest nsubstitute-if-not-bit-vector.3
434
  (let* ((orig #*010101)
sds's avatar
sds committed
435 436
         (x (copy-seq orig))
         (result (nsubstitute-if-not 0 (is-not-eql-p 1) x)))
437 438 439
    result)
  #*000000)

440
(deftest nsubstitute-if-not-bit-vector.4
441
  (let* ((orig #*010101)
sds's avatar
sds committed
442 443
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x)))
444 445 446
    result)
  #*111111)

447
(deftest nsubstitute-if-not-bit-vector.5
448
  (let* ((orig #*010101)
sds's avatar
sds committed
449 450
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :start 1)))
451 452
    result)
  #*011111)
sds's avatar
sds committed
453

454
(deftest nsubstitute-if-not-bit-vector.6
455
  (let* ((orig #*010101)
sds's avatar
sds committed
456 457
         (x (copy-seq orig))
         (result (nsubstitute-if-not 0 (is-not-eql-p 1) x :start 2 :end nil)))
458 459 460
    result)
  #*010000)

461
(deftest nsubstitute-if-not-bit-vector.7
462
  (let* ((orig #*010101)
sds's avatar
sds committed
463 464
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :end 4)))
465 466
    result)
  #*111101)
sds's avatar
sds committed
467

468
(deftest nsubstitute-if-not-bit-vector.8
469
  (let* ((orig #*010101)
sds's avatar
sds committed
470 471
         (x (copy-seq orig))
         (result (nsubstitute-if-not 0 (is-not-eql-p 1) x :end nil)))
472 473 474
    result)
  #*000000)

475
(deftest nsubstitute-if-not-bit-vector.9
476
  (let* ((orig #*010101)
sds's avatar
sds committed
477 478
         (x (copy-seq orig))
         (result (nsubstitute-if-not 0 (is-not-eql-p 1) x :end 3)))
479 480 481
    result)
  #*000101)

482
(deftest nsubstitute-if-not-bit-vector.10
483
  (let* ((orig #*010101)
sds's avatar
sds committed
484 485
         (x (copy-seq orig))
         (result (nsubstitute-if-not 0 (is-not-eql-p 1) x :start 2 :end 4)))
486 487 488
    result)
  #*010001)

489
(deftest nsubstitute-if-not-bit-vector.11
490
  (let* ((orig #*010101)
sds's avatar
sds committed
491 492
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :start 2 :end 4)))
493 494 495
    result)
  #*011101)

496
(deftest nsubstitute-if-not-bit-vector.12
497
  (let* ((orig #*010101)
sds's avatar
sds committed
498 499
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count 1)))
500 501 502
    result)
  #*110101)

503
(deftest nsubstitute-if-not-bit-vector.13
504
  (let* ((orig #*010101)
sds's avatar
sds committed
505 506
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count 0)))
507 508 509
    result)
  #*010101)

510
(deftest nsubstitute-if-not-bit-vector.14
511
  (let* ((orig #*010101)
sds's avatar
sds committed
512 513
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count -1)))
514 515 516
    result)
  #*010101)

517
(deftest nsubstitute-if-not-bit-vector.15
518
  (let* ((orig #*010101)
sds's avatar
sds committed
519 520
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count 1 :from-end t)))
521 522 523
    result)
  #*010111)

524
(deftest nsubstitute-if-not-bit-vector.16
525
  (let* ((orig #*010101)
sds's avatar
sds committed
526 527
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count 0 :from-end t)))
528 529 530
    result)
  #*010101)

531
(deftest nsubstitute-if-not-bit-vector.17
532
  (let* ((orig #*010101)
sds's avatar
sds committed
533 534
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count -1 :from-end t)))
535 536 537
    result)
  #*010101)

538
(deftest nsubstitute-if-not-bit-vector.18
539
  (let* ((orig #*010101)
sds's avatar
sds committed
540 541
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count nil)))
542 543 544
    result)
  #*111111)

545
(deftest nsubstitute-if-not-bit-vector.19
546
  (let* ((orig #*010101)
sds's avatar
sds committed
547 548
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 0) x :count nil :from-end t)))
549 550 551
    result)
  #*111111)

552
(deftest nsubstitute-if-not-bit-vector.20
553
  (loop for i from 0 to 9 always
sds's avatar
sds committed
554 555 556 557 558 559 560 561 562 563
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig #*0000000000)
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not 1 (is-not-eql-p 0) x :start i :end j :count c)))
                      (equalp y (concatenate
                                 'simple-bit-vector
                                 (make-list i :initial-element 0)
                                 (make-list c :initial-element 1)
                                 (make-list (- 10 (+ i c)) :initial-element 0)))))))
564 565
  t)

566
(deftest nsubstitute-if-not-bit-vector.21
567
  (loop for i from 0 to 9 always
sds's avatar
sds committed
568 569 570 571 572 573 574 575 576 577
        (loop for j from i to 10 always
              (loop for c from 0 to (- j i) always
                    (let* ((orig #*1111111111)
                           (x (copy-seq orig))
                           (y (nsubstitute-if-not 0 (is-not-eql-p 1) x :start i :end j :count c :from-end t)))
                      (equalp y (concatenate
                                 'simple-bit-vector
                                 (make-list (- j c) :initial-element 1)
                                 (make-list c :initial-element 0)
                                 (make-list (- 10 j) :initial-element 1)))))))
578 579 580 581 582 583 584
  t)


;;; More tests

(deftest nsubstitute-if-not-list.24
  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
585 586
         (x (copy-seq orig))
         (result (nsubstitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
587 588 589 590 591
    result)
  ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))

(deftest nsubstitute-if-not-list.25
  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
592 593 594
         (x (copy-seq orig))
         (result (nsubstitute-if-not '(a 10) (is-not-eql-p 'a) x
                                :key #'car :start 1 :end 5)))
595 596 597 598 599
    result)
  ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))

(deftest nsubstitute-if-not-vector.24
  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
600 601
         (x (copy-seq orig))
         (result (nsubstitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
602 603
    result)
  #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
sds's avatar
sds committed
604

605 606
(deftest nsubstitute-if-not-vector.25
  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
607 608
         (x (copy-seq orig))
         (result (nsubstitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car :start 1 :end 5)))
609 610 611 612 613
    result)
  #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))

(deftest nsubstitute-if-not-string.24
  (let* ((orig "0102342015")
sds's avatar
sds committed
614 615
         (x (copy-seq orig))
         (result (nsubstitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit)))
616 617
    result)
  "a1a2342a15")
sds's avatar
sds committed
618

619 620
(deftest nsubstitute-if-not-string.25
  (let* ((orig "0102342015")
sds's avatar
sds committed
621 622
         (x (copy-seq orig))
         (result (nsubstitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit :start 1 :end 6)))
623 624 625
    result)
  "01a2342015")

626
(deftest nsubstitute-if-not-bit-vector.26
627
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
628 629
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 1) x :key #'1+)))
630 631
    result)
  #*11111111111111111)
sds's avatar
sds committed
632

633
(deftest nsubstitute-if-not-bit-vector.27
634
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
635 636
         (x (copy-seq orig))
         (result (nsubstitute-if-not 1 (is-not-eql-p 1) x :key #'1+ :start 1 :end 10)))
637
    result)
638
  #*01111111111010110)
639 640 641

(deftest nsubstitute-if-not-bit-vector.30
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
sds's avatar
sds committed
642 643
                       :fill-pointer 5 :element-type 'bit))
         (result (nsubstitute-if-not 1 #'onep x)))
644 645 646 647 648
    result)
  #*11111)

(deftest nsubstitute-if-not-bit-vector.31
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
sds's avatar
sds committed
649 650
                       :fill-pointer 5 :element-type 'bit))
         (result (nsubstitute-if-not 1 #'onep x :from-end t)))
651 652 653 654 655
    result)
  #*11111)

(deftest nsubstitute-if-not-bit-vector.32
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
sds's avatar
sds committed
656 657
                       :fill-pointer 5 :element-type 'bit))
         (result (nsubstitute-if-not 1 #'onep x :count 1)))
658 659 660 661 662
    result)
  #*11011)

(deftest nsubstitute-if-not-bit-vector.33
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
sds's avatar
sds committed
663 664
                       :fill-pointer 5 :element-type 'bit))
         (result (nsubstitute-if-not 1 #'onep x :from-end t :count 1)))
665 666
    result)
  #*01111)
667

668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702
(deftest nsubstitute-if-not.order.1
  (let ((i 0) a b c d e f g h)
    (values
     (nsubstitute-if-not
      (progn (setf a (incf i)) 'a)
      (progn (setf b (incf i)) #'identity)
      (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
      :count (progn (setf d (incf i)) 2)
      :start (progn (setf e (incf i)) 0)
      :end (progn (setf f (incf i)) 7)
      :key (progn (setf g (incf i)) #'identity)
      :from-end (setf h (incf i))
      )
     i a b c d e f g h))
  (nil 1 2 a 3 4 a 5)
  8 1 2 3 4 5 6 7 8)

(deftest nsubstitute-if-not.order.2
  (let ((i 0) a b c d e f g h)
    (values
     (nsubstitute-if-not
      (progn (setf a (incf i)) 'a)
      (progn (setf b (incf i)) #'identity)
      (progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
      :from-end (setf h (incf i))
      :key (progn (setf g (incf i)) #'identity)
      :end (progn (setf f (incf i)) 7)
      :start (progn (setf e (incf i)) 0)
      :count (progn (setf d (incf i)) 2)
      )
     i a b c d e f g h))
  (nil 1 2 a 3 4 a 5)
  8 1 2 3 8 7 6 5 4)


703 704 705 706
;;; Keyword tests

(deftest nsubstitute-if-not.allow-other-keys.1
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
707
                      :allow-other-keys t :bad t)
708 709 710 711
  (a a 0 a a 0 a))

(deftest nsubstitute-if-not.allow-other-keys.2
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
712
                      :bad t :allow-other-keys t)
713 714 715 716
  (a a 0 a a 0 a))

(deftest nsubstitute-if-not.allow-other-keys.3
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
sds's avatar
sds committed
717
                  :allow-other-keys nil :bad t)
718 719 720 721
  (a a 0 a a 0 a))

(deftest nsubstitute-if-not.allow-other-keys.4
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :bad t
sds's avatar
sds committed
722
                  :allow-other-keys t :allow-other-keys nil)
723 724 725 726
  (a a 0 a a 0 a))

(deftest nsubstitute-if-not.allow-other-keys.5
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
727
                  :allow-other-keys t :key #'1-)
728 729 730 731
  (1 a a a 1 a a))

(deftest nsubstitute-if-not.keywords.6
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
732
                      :key #'1- :key #'identity)
733 734 735 736
  (1 a a a 1 a a))

(deftest nsubstitute-if-not.allow-other-keys.7
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
sds's avatar
sds committed
737
                  :bad t :allow-other-keys nil)
738 739 740 741 742 743 744
  (a a 0 a a 0 a))

(deftest nsubstitute-if-not.allow-other-keys.8
  (nsubstitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil)
  (a a 0 a a 0 a))


745 746 747
;;; Error cases

(deftest nsubstitute-if-not.error.1
748 749
  (signals-error (nsubstitute-if-not) program-error)
  t)
750 751

(deftest nsubstitute-if-not.error.2
752 753
  (signals-error (nsubstitute-if-not 'a) program-error)
  t)
754 755

(deftest nsubstitute-if-not.error.3
756 757
  (signals-error (nsubstitute-if-not 'a #'null) program-error)
  t)
758 759

(deftest nsubstitute-if-not.error.4
760 761
  (signals-error (nsubstitute-if-not 'a #'null nil 'bad t) program-error)
  t)
762 763

(deftest nsubstitute-if-not.error.5
764
  (signals-error (nsubstitute-if-not 'a #'null nil
sds's avatar
sds committed
765 766
                                      'bad t :allow-other-keys nil)
                 program-error)
767
  t)
768 769

(deftest nsubstitute-if-not.error.6
770 771
  (signals-error (nsubstitute-if-not 'a #'null nil :key) program-error)
  t)
772 773

(deftest nsubstitute-if-not.error.7
774 775
  (signals-error (nsubstitute-if-not 'a #'null nil 1 2) program-error)
  t)
776

777
(deftest nsubstitute-if-not.error.8
778 779
  (signals-error (nsubstitute-if-not 'a #'cons (list 'a 'b 'c)) program-error)
  t)
780 781

(deftest nsubstitute-if-not.error.9
782 783
  (signals-error (nsubstitute-if-not 'a #'car (list 'a 'b 'c)) type-error)
  t)
784 785

(deftest nsubstitute-if-not.error.10
786
  (signals-error (nsubstitute-if-not 'a #'identity (list 'a 'b 'c)
sds's avatar
sds committed
787 788
                                  :key #'car)
                 type-error)
789
  t)
790 791

(deftest nsubstitute-if-not.error.11
792
  (signals-error (nsubstitute-if-not 'a #'identity (list 'a 'b 'c)
sds's avatar
sds committed
793 794
                                  :key #'cons)
                 program-error)
795
  t)
796

pfdietz's avatar
pfdietz committed
797 798 799
(deftest nsubstitute-if-not.error.12
  (check-type-error #'(lambda (x) (nsubstitute-if-not 1 #'null x)) #'sequencep)
  nil)