substitute-if-not.lsp 30.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Aug 31 18:17:09 2002
;;;; Contains: Tests for SUBSTITUTE-IF-NOT

(in-package :cl-test)

(deftest substitute-if-not-list.1
  (let ((x '())) (values (substitute-if-not 'b #'null x) x))
  nil nil)

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

(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 20 21 22
  (b b b c)
  (a b a c))

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

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

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

(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 40 41 42
  (a b a c)
  (a b a c))

(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 45 46
  nil nil)

(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 49 50 51
  (b b b c)
  (a b a c))

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

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

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

(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 69 70 71
  (a b a c)
  (a b a c))

(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 74 75 76 77
  (a b a c)
  (a b a c))

(deftest substitute-if-not-list.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
78 79 80 81 82 83 84 85
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
                (and (equal orig x)
                     (equal y (nconc (make-list i :initial-element 'a)
                                     (make-list (- j i) :initial-element 'x)
                                     (make-list (- 10 j) :initial-element 'a)))))))
86 87 88 89
  t)

(deftest substitute-if-not-list.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
90 91 92 93 94 95 96 97
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
                (and (equal orig x)
                     (equal y (nconc (make-list i :initial-element 'a)
                                     (make-list (- j i) :initial-element 'x)
                                     (make-list (- 10 j) :initial-element 'a)))))))
98 99 100 101
  t)

(deftest substitute-if-not-list.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
102 103 104 105 106 107 108 109 110
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
                      (and (equal orig x)
                           (equal y (nconc (make-list i :initial-element 'a)
                                           (make-list c :initial-element 'x)
                                           (make-list (- 10 (+ i c)) :initial-element 'a))))))))
111 112 113 114
  t)

(deftest substitute-if-not-list.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
115 116 117 118 119 120 121 122 123
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
                      (and (equal orig x)
                           (equal y (nconc (make-list (- j c) :initial-element 'a)
                                           (make-list c :initial-element 'x)
                                           (make-list (- 10 j) :initial-element 'a))))))))
124 125 126 127 128
  t)

;;; Tests on vectors

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

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

(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 145 146 147
  #(b b b c)
  #(a b a c))

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

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

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

(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 169 170 171
  #(b b b c)
  #(a b a c))

(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 174 175 176
  #(b b b c)
  #(a b a c))

(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 179 180 181
  #(b b b c)
  #(a b a c))

(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 184 185 186
  #(a b b c)
  #(a b a c))

(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 189 190 191
  #(a b a c)
  #(a b a c))

(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 194 195 196 197
  #(a b a c)
  #(a b a c))

(deftest substitute-if-not-vector.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
198 199 200 201 202 203 204 205 206
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
                (and (equalp orig x)
                     (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)))))))
207 208 209 210
  t)

(deftest substitute-if-not-vector.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
211 212 213 214 215 216 217 218 219
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
                (and (equalp orig x)
                     (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)))))))
220 221 222 223
  t)

(deftest substitute-if-not-vector.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
224 225 226 227 228 229 230 231 232 233
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
                      (and (equalp orig x)
                           (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))))))))
234 235 236 237
  t)

(deftest substitute-if-not-vector.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
238 239 240 241 242 243 244 245 246 247
        (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 (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
                      (and (equalp orig x)
                           (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))))))))
248 249
  t)

250 251
(deftest substitute-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
252 253
                       :fill-pointer 5))
         (result (substitute-if-not 'z (is-not-eql-p 'a) x)))
254 255 256 257 258
    result)
  #(z b z c b))

(deftest substitute-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
259 260
                       :fill-pointer 5))
         (result (substitute-if-not 'z (is-not-eql-p 'a) x :from-end t)))
261 262 263 264 265
    result)
  #(z b z c b))

(deftest substitute-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
266 267
                       :fill-pointer 5))
         (result (substitute-if-not 'z (is-not-eql-p 'a) x :count 1)))
268 269 270 271 272
    result)
  #(z b a c b))

(deftest substitute-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
273 274 275
                       :fill-pointer 5))
         (result (substitute-if-not 'z (is-not-eql-p 'a) x
                                    :from-end t :count 1)))
276 277 278
    result)
  #(a b z c b))

279 280
(deftest substitute-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
281 282
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
283 284 285 286 287 288 289 290
    (values
     (substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1)
     v1))
  #(d a b x d a b c)
  #(a b c d a b c d a b c d a b c d))

(deftest substitute-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
291 292
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
293 294 295 296 297 298 299
    (values
     (substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1 :from-end t)
     v1))
  #(d a b c d a b x)
  #(a b c d a b c d a b c d a b c d))


300

301 302 303
;;; Tests on strings

(deftest substitute-if-not-string.1
304
  (let ((x "")) (values (substitute-if-not #\b (is-not-eql-p #\a) x) x))
305 306 307
  "" "")

(deftest substitute-if-not-string.2
308
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x) x))
309 310 311 312
  "bbbc"
  "abac")

(deftest substitute-if-not-string.3
313
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count nil) x))
314 315 316 317
  "bbbc"
  "abac")

(deftest substitute-if-not-string.4
318
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 2) x))
319 320 321 322
  "bbbc"
  "abac")

(deftest substitute-if-not-string.5
323
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 1) x))
324 325 326 327
  "bbac"
  "abac")

(deftest substitute-if-not-string.6
328
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 0) x))
329 330 331 332
  "abac"
  "abac")

(deftest substitute-if-not-string.7
333
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count -1) x))
334 335 336 337
  "abac"
  "abac")

(deftest substitute-if-not-string.8
338
  (let ((x "")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t) x))
339 340 341
  "" "")

(deftest substitute-if-not-string.9
342
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t) x))
343 344 345 346
  "bbbc"
  "abac")

(deftest substitute-if-not-string.10
347
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t :count nil) x))
348 349 350 351
  "bbbc"
  "abac")

(deftest substitute-if-not-string.11
352
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 2 :from-end t) x))
353 354 355 356
  "bbbc"
  "abac")

(deftest substitute-if-not-string.12
357
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 1 :from-end t) x))
358 359 360 361
  "abbc"
  "abac")

(deftest substitute-if-not-string.13
362
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 0 :from-end t) x))
363 364 365 366
  "abac"
  "abac")

(deftest substitute-if-not-string.14
367
  (let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count -1 :from-end t) x))
368 369 370 371 372
  "abac"
  "abac")

(deftest substitute-if-not-string.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
373 374 375 376 377 378 379 380 381
        (loop for j from i to 10 always
              (let* ((orig "aaaaaaaaaa")
                     (x (copy-seq orig))
                     (y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j)))
                (and (equalp orig x)
                     (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)))))))
382 383 384 385
  t)

(deftest substitute-if-not-string.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
386 387 388 389 390 391 392 393 394
        (loop for j from i to 10 always
              (let* ((orig "aaaaaaaaaa")
                     (x (copy-seq orig))
                     (y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :from-end t)))
                (and (equalp orig x)
                     (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)))))))
395 396 397 398
  t)

(deftest substitute-if-not-string.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
399 400 401 402 403 404 405 406 407 408
        (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 (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c)))
                      (and (equalp orig x)
                           (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))))))))
409 410 411 412
  t)

(deftest substitute-if-not-string.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
413 414 415 416 417 418 419 420 421 422
        (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 (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c :from-end t)))
                      (and (equalp orig x)
                           (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))))))))
423 424
  t)

425
(deftest substitute-if-not-string.28
426
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
427 428
                       :fill-pointer 5 :element-type 'character))
         (result (substitute-if-not #\z (is-not-eql-p #\a) x)))
429 430 431 432
    result)
  "zbzcb")

(deftest substitute-if-not-string.29
433
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
434 435
                       :fill-pointer 5 :element-type 'character))
         (result (substitute-if-not #\z (is-not-eql-p #\a) x :from-end t)))
436 437 438 439
    result)
  "zbzcb")

(deftest substitute-if-not-string.30
440
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
441 442
                       :fill-pointer 5 :element-type 'character))
         (result (substitute-if-not #\z (is-not-eql-p #\a) x :count 1)))
443 444 445 446
    result)
  "zbacb")

(deftest substitute-if-not-string.31
447
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
448 449 450
                       :fill-pointer 5 :element-type 'character))
         (result (substitute-if-not #\z (is-not-eql-p #\a) x
                                    :from-end t :count 1)))
451 452 453 454 455
    result)
  "abzcb")



456 457 458 459
;;; Tests on bitstrings

(deftest substitute-if-not-bitstring.1
  (let* ((orig #*)
sds's avatar
sds committed
460 461
         (x (copy-seq orig))
         (result (substitute-if-not 0 (is-not-eql-p 1) x)))
462
    (and (equalp orig x)
sds's avatar
sds committed
463
         result))
464 465 466 467
  #*)

(deftest substitute-if-not-bitstring.2
  (let* ((orig #*)
sds's avatar
sds committed
468 469
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x)))
470
    (and (equalp orig x)
sds's avatar
sds committed
471
         result))
472 473 474 475
  #*)

(deftest substitute-if-not-bitstring.3
  (let* ((orig #*010101)
sds's avatar
sds committed
476 477
         (x (copy-seq orig))
         (result (substitute-if-not 0 (is-not-eql-p 1) x)))
478
    (and (equalp orig x)
sds's avatar
sds committed
479
         result))
480 481 482 483
  #*000000)

(deftest substitute-if-not-bitstring.4
  (let* ((orig #*010101)
sds's avatar
sds committed
484 485
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x)))
486
    (and (equalp orig x)
sds's avatar
sds committed
487
         result))
488 489 490 491
  #*111111)

(deftest substitute-if-not-bitstring.5
  (let* ((orig #*010101)
sds's avatar
sds committed
492 493
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :start 1)))
494
    (and (equalp orig x)
sds's avatar
sds committed
495
         result))
496
  #*011111)
sds's avatar
sds committed
497

498 499
(deftest substitute-if-not-bitstring.6
  (let* ((orig #*010101)
sds's avatar
sds committed
500 501
         (x (copy-seq orig))
         (result (substitute-if-not 0 (is-not-eql-p 1) x :start 2 :end nil)))
502
    (and (equalp orig x)
sds's avatar
sds committed
503
         result))
504 505 506 507
  #*010000)

(deftest substitute-if-not-bitstring.7
  (let* ((orig #*010101)
sds's avatar
sds committed
508 509
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :end 4)))
510
    (and (equalp orig x)
sds's avatar
sds committed
511
         result))
512
  #*111101)
sds's avatar
sds committed
513

514 515
(deftest substitute-if-not-bitstring.8
  (let* ((orig #*010101)
sds's avatar
sds committed
516 517
         (x (copy-seq orig))
         (result (substitute-if-not 0 (is-not-eql-p 1) x :end nil)))
518
    (and (equalp orig x)
sds's avatar
sds committed
519
         result))
520 521 522 523
  #*000000)

(deftest substitute-if-not-bitstring.9
  (let* ((orig #*010101)
sds's avatar
sds committed
524 525
         (x (copy-seq orig))
         (result (substitute-if-not 0 (is-not-eql-p 1) x :end 3)))
526
    (and (equalp orig x)
sds's avatar
sds committed
527
         result))
528 529 530 531
  #*000101)

(deftest substitute-if-not-bitstring.10
  (let* ((orig #*010101)
sds's avatar
sds committed
532 533
         (x (copy-seq orig))
         (result (substitute-if-not 0 (is-not-eql-p 1) x :start 2 :end 4)))
534
    (and (equalp orig x)
sds's avatar
sds committed
535
         result))
536 537 538 539
  #*010001)

(deftest substitute-if-not-bitstring.11
  (let* ((orig #*010101)
sds's avatar
sds committed
540 541
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :start 2 :end 4)))
542
    (and (equalp orig x)
sds's avatar
sds committed
543
         result))
544 545 546 547
  #*011101)

(deftest substitute-if-not-bitstring.12
  (let* ((orig #*010101)
sds's avatar
sds committed
548 549
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count 1)))
550
    (and (equalp orig x)
sds's avatar
sds committed
551
         result))
552 553 554 555
  #*110101)

(deftest substitute-if-not-bitstring.13
  (let* ((orig #*010101)
sds's avatar
sds committed
556 557
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count 0)))
558
    (and (equalp orig x)
sds's avatar
sds committed
559
         result))
560 561 562 563
  #*010101)

(deftest substitute-if-not-bitstring.14
  (let* ((orig #*010101)
sds's avatar
sds committed
564 565
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count -1)))
566
    (and (equalp orig x)
sds's avatar
sds committed
567
         result))
568 569 570 571
  #*010101)

(deftest substitute-if-not-bitstring.15
  (let* ((orig #*010101)
sds's avatar
sds committed
572 573
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count 1 :from-end t)))
574
    (and (equalp orig x)
sds's avatar
sds committed
575
         result))
576 577 578 579
  #*010111)

(deftest substitute-if-not-bitstring.16
  (let* ((orig #*010101)
sds's avatar
sds committed
580 581
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count 0 :from-end t)))
582
    (and (equalp orig x)
sds's avatar
sds committed
583
         result))
584 585 586 587
  #*010101)

(deftest substitute-if-not-bitstring.17
  (let* ((orig #*010101)
sds's avatar
sds committed
588 589
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count -1 :from-end t)))
590
    (and (equalp orig x)
sds's avatar
sds committed
591
         result))
592 593 594 595
  #*010101)

(deftest substitute-if-not-bitstring.18
  (let* ((orig #*010101)
sds's avatar
sds committed
596 597
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count nil)))
598
    (and (equalp orig x)
sds's avatar
sds committed
599
         result))
600 601 602 603
  #*111111)

(deftest substitute-if-not-bitstring.19
  (let* ((orig #*010101)
sds's avatar
sds committed
604 605
         (x (copy-seq orig))
         (result (substitute-if-not 1 (complement #'zerop) x :count nil :from-end t)))
606
    (and (equalp orig x)
sds's avatar
sds committed
607
         result))
608 609 610 611
  #*111111)

(deftest substitute-if-not-bitstring.20
  (loop for i from 0 to 9 always
sds's avatar
sds committed
612 613 614 615 616 617 618 619 620 621 622
        (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 (substitute-if-not 1 (complement #'zerop) x :start i :end j :count c)))
                      (and (equalp orig x)
                           (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))))))))
623 624 625 626
  t)

(deftest substitute-if-not-bitstring.21
  (loop for i from 0 to 9 always
sds's avatar
sds committed
627 628 629 630 631 632 633 634 635 636 637
        (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 (substitute-if-not 0 (is-not-eql-p 1) x :start i :end j :count c :from-end t)))
                      (and (equalp orig x)
                           (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))))))))
638 639 640 641 642 643
  t)

;;; More tests

(deftest substitute-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
644 645
         (x (copy-seq orig))
         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
646
    (and (equal orig x)
sds's avatar
sds committed
647
         result))
648 649 650 651
  ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))

(deftest substitute-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
652 653 654
         (x (copy-seq orig))
         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x
                                :key #'car :start 1 :end 5)))
655
    (and (equal orig x)
sds's avatar
sds committed
656
         result))
657 658 659 660
  ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))

(deftest substitute-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
661 662
         (x (copy-seq orig))
         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
663
    (and (equalp orig x)
sds's avatar
sds committed
664
         result))
665
  #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
sds's avatar
sds committed
666

667 668
(deftest substitute-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
669 670
         (x (copy-seq orig))
         (result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car :start 1 :end 5)))
671
    (and (equalp orig x)
sds's avatar
sds committed
672
         result))
673 674 675 676
  #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))

(deftest substitute-if-not-string.24
  (let* ((orig "0102342015")
sds's avatar
sds committed
677 678
         (x (copy-seq orig))
         (result (substitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit)))
679
    (and (equalp orig x)
sds's avatar
sds committed
680
         result))
681
  "a1a2342a15")
sds's avatar
sds committed
682

683 684
(deftest substitute-if-not-string.25
  (let* ((orig "0102342015")
sds's avatar
sds committed
685 686
         (x (copy-seq orig))
         (result (substitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit :start 1 :end 6)))
687
    (and (equalp orig x)
sds's avatar
sds committed
688
         result))
689 690
  "01a2342015")

691 692 693 694 695 696 697 698 699
(deftest substitute-if-not-string.26
  (do-special-strings
   (s "xyzabcxyzabc" nil)
   (assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s) "xyz!bcxyz!bc"))
   (assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1) "xyz!bcxyzabc"))
   (assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc"))
   (assert (string= s "xyzabcxyzabc")))
  nil)

700 701
(deftest substitute-if-not-bitstring.26
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
702 703
         (x (copy-seq orig))
         (result (substitute-if-not 1 (is-not-eql-p 1) x :key #'1+)))
704
    (and (equalp orig x)
sds's avatar
sds committed
705
         result))
706
  #*11111111111111111)
sds's avatar
sds committed
707

708 709
(deftest substitute-if-not-bitstring.27
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
710 711
         (x (copy-seq orig))
         (result (substitute-if-not 1 (is-not-eql-p 1) x :key #'1+ :start 1 :end 10)))
712
    (and (equalp orig x)
sds's avatar
sds committed
713
         result))
714
  #*01111111111010110)
715 716 717

(deftest substitute-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
718 719
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute-if-not 1 #'onep x)))
720 721 722 723 724
    result)
  #*11111)

(deftest substitute-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
725 726
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute-if-not 1 #'onep x :from-end t)))
727 728 729 730 731
    result)
  #*11111)

(deftest substitute-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
732 733
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute-if-not 1 #'onep x :count 1)))
734 735 736 737 738
    result)
  #*11011)

(deftest substitute-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
739 740
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute-if-not 1 #'onep x :from-end t :count 1)))
741 742
    result)
  #*01111)
743

744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777
(deftest substitute-if-not.order.1
  (let ((i 0) a b c d e f g h)
    (values
     (substitute-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 substitute-if-not.order.2
  (let ((i 0) a b c d e f g h)
    (values
     (substitute-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)

778 779 780 781
;;; Keyword tests

(deftest substitute-if-not.allow-other-keys.1
  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
782
                      :allow-other-keys t :bad t)
783 784 785 786
  (a a 0 a a 0 a))

(deftest substitute-if-not.allow-other-keys.2
  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
787
                      :bad t :allow-other-keys t)
788 789 790 791
  (a a 0 a a 0 a))

(deftest substitute-if-not.allow-other-keys.3
  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
sds's avatar
sds committed
792
                  :allow-other-keys nil :bad t)
793 794 795 796
  (a a 0 a a 0 a))

(deftest substitute-if-not.allow-other-keys.4
  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :bad t
sds's avatar
sds committed
797
                  :allow-other-keys t :allow-other-keys nil)
798 799 800 801
  (a a 0 a a 0 a))

(deftest substitute-if-not.allow-other-keys.5
  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
802
                  :allow-other-keys t :key #'1-)
803 804 805 806
  (1 a a a 1 a a))

(deftest substitute-if-not.keywords.6
  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
807
                      :key #'1- :key #'identity)
808 809 810 811
  (1 a a a 1 a a))

(deftest substitute-if-not.allow-other-keys.7
  (substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
sds's avatar
sds committed
812
                  :bad t :allow-other-keys nil)
813 814 815 816 817 818
  (a a 0 a a 0 a))

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

819 820
;;; Constant folding tests

821 822 823 824 825 826 827 828
(def-fold-test substitute-if-not.fold.1
  (substitute-if-not 'z 'identity '(a nil b)))
(def-fold-test substitute-if-not.fold.2
  (substitute-if-not 'z 'identity #(a nil b)))
(def-fold-test substitute-if-not.fold.3
  (substitute-if-not 0 'zerop #*100110))
(def-fold-test substitute-if-not.fold.4
  (substitute-if-not #\0 #'digit-char-p "asdaw82213nn1239123dd"))
829

830 831 832
;;; Error cases

(deftest substitute-if-not.error.1
833 834
  (signals-error (substitute-if-not) program-error)
  t)
835 836

(deftest substitute-if-not.error.2
837 838
  (signals-error (substitute-if-not 'a) program-error)
  t)
839 840

(deftest substitute-if-not.error.3
841 842
  (signals-error (substitute-if-not 'a #'null) program-error)
  t)
843 844

(deftest substitute-if-not.error.4
845 846
  (signals-error (substitute-if-not 'a #'null nil 'bad t) program-error)
  t)
847 848

(deftest substitute-if-not.error.5
849
  (signals-error (substitute-if-not 'a #'null nil
sds's avatar
sds committed
850
                                      'bad t :allow-other-keys nil) program-error)
851
  t)
852 853

(deftest substitute-if-not.error.6
854 855
  (signals-error (substitute-if-not 'a #'null nil :key) program-error)
  t)
856 857

(deftest substitute-if-not.error.7
858 859
  (signals-error (substitute-if-not 'a #'null nil 1 2) program-error)
  t)
860 861

(deftest substitute-if-not.error.8
862 863
  (signals-error (substitute-if-not 'a #'cons (list 'a 'b 'c)) program-error)
  t)
864 865

(deftest substitute-if-not.error.9
866 867
  (signals-error (substitute-if-not 'a #'car (list 'a 'b 'c)) type-error)
  t)
868 869

(deftest substitute-if-not.error.10
870
  (signals-error (substitute-if-not 'a #'identity (list 'a 'b 'c)
sds's avatar
sds committed
871 872
                                  :key #'car)
                 type-error)
873
  t)
874 875

(deftest substitute-if-not.error.11
876
  (signals-error (substitute-if-not 'a #'identity (list 'a 'b 'c)
sds's avatar
sds committed
877 878
                                  :key #'cons)
                 program-error)
879
  t)
880

881 882 883
(deftest substitute-if-not.error.12
  (check-type-error #'(lambda (x) (substitute-if-not 'a #'not x)) #'sequencep)
  nil)