substitute.lsp 36.1 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Aug 28 21:15:33 2002
;;;; Contains: Tests for SUBSTITUTE

(in-package :cl-test)

(deftest substitute-list.1
  (let ((x '())) (values (substitute 'b 'a x) x))
  nil nil)

(deftest substitute-list.2
  (let ((x '(a b a c))) (values (substitute 'b 'a x) x))
  (b b b c)
  (a b a c))

(deftest substitute-list.3
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count nil) x))
  (b b b c)
  (a b a c))

(deftest substitute-list.4
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 2) x))
  (b b b c)
  (a b a c))

(deftest substitute-list.5
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 1) x))
  (b b a c)
  (a b a c))

(deftest substitute-list.6
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 0) x))
  (a b a c)
  (a b a c))

(deftest substitute-list.7
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count -1) x))
  (a b a c)
  (a b a c))

(deftest substitute-list.8
  (let ((x '())) (values (substitute 'b 'a x :from-end t) x))
  nil nil)

(deftest substitute-list.9
  (let ((x '(a b a c))) (values (substitute 'b 'a x :from-end t) x))
  (b b b c)
  (a b a c))

(deftest substitute-list.10
  (let ((x '(a b a c))) (values (substitute 'b 'a x :from-end t :count nil) x))
  (b b b c)
  (a b a c))

(deftest substitute-list.11
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 2 :from-end t) x))
  (b b b c)
  (a b a c))

(deftest substitute-list.12
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 1 :from-end t) x))
  (a b b c)
  (a b a c))

(deftest substitute-list.13
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count 0 :from-end t) x))
  (a b a c)
  (a b a c))

(deftest substitute-list.14
  (let ((x '(a b a c))) (values (substitute 'b 'a x :count -1 :from-end t) x))
  (a b a c)
  (a b a c))

(deftest substitute-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 'x '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-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 'x '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-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 'x '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-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 'x '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
  t)

(deftest substitute-list.19
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
128 129
         (x (copy-seq orig))
         (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2)))))
130
    (and (equal orig x)
sds's avatar
sds committed
131
         result))
132 133 134 135
  (1 2 x x x x x 8 9))

(deftest substitute-list.20
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
136 137 138
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a)))))
139
    (and (equal orig x)
sds's avatar
sds committed
140
         result))
141 142 143 144 145
  (1 2 x 4 5 6 7 8 9))


(deftest substitute-list.21
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
146 147 148 149
         (x (copy-seq orig))
         (c 5)
         (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a))
                             :from-end t)))
150
    (and (equal orig x)
sds's avatar
sds committed
151
         result))
152 153 154 155
  (1 2 3 4 5 6 7 x 9))

(deftest substitute-list.22
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
156 157 158
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a)))))
159
    (and (equal orig x)
sds's avatar
sds committed
160
         result))
161 162 163 164 165
  (1 2 x 4 5 6 7 8 9))


(deftest substitute-list.23
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
166 167 168 169
         (x (copy-seq orig))
         (c 5)
         (result (substitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a))
                             :from-end t)))
170
    (and (equal orig x)
sds's avatar
sds committed
171
         result))
172 173 174 175
  (1 2 3 4 5 6 7 x 9))

(deftest substitute-list.24
  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
176 177
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car)))
178
    (and (equal orig x)
sds's avatar
sds committed
179
         result))
180 181 182 183
  ((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))

(deftest substitute-list.25
  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
184 185
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5)))
186
    (and (equal orig x)
sds's avatar
sds committed
187
         result))
188 189 190 191
  ((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))

(deftest substitute-list.26
  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
192 193
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql))))
194
    (and (equal orig x)
sds's avatar
sds committed
195
         result))
196 197 198 199
  ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))

(deftest substitute-list.27
  (let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
200 201
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test-not #'eql)))
202
    (and (equal orig x)
sds's avatar
sds committed
203 204
         result))
  ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277

;;; Tests on vectors

(deftest substitute-vector.1
  (let ((x #())) (values (substitute 'b 'a x) x))
  #() #())

(deftest substitute-vector.2
  (let ((x #(a b a c))) (values (substitute 'b 'a x) x))
  #(b b b c)
  #(a b a c))

(deftest substitute-vector.3
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count nil) x))
  #(b b b c)
  #(a b a c))

(deftest substitute-vector.4
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 2) x))
  #(b b b c)
  #(a b a c))

(deftest substitute-vector.5
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 1) x))
  #(b b a c)
  #(a b a c))

(deftest substitute-vector.6
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 0) x))
  #(a b a c)
  #(a b a c))

(deftest substitute-vector.7
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count -1) x))
  #(a b a c)
  #(a b a c))

(deftest substitute-vector.8
  (let ((x #())) (values (substitute 'b 'a x :from-end t) x))
  #() #())

(deftest substitute-vector.9
  (let ((x #(a b a c))) (values (substitute 'b 'a x :from-end t) x))
  #(b b b c)
  #(a b a c))

(deftest substitute-vector.10
  (let ((x #(a b a c))) (values (substitute 'b 'a x :from-end t :count nil) x))
  #(b b b c)
  #(a b a c))

(deftest substitute-vector.11
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 2 :from-end t) x))
  #(b b b c)
  #(a b a c))

(deftest substitute-vector.12
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 1 :from-end t) x))
  #(a b b c)
  #(a b a c))

(deftest substitute-vector.13
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count 0 :from-end t) x))
  #(a b a c)
  #(a b a c))

(deftest substitute-vector.14
  (let ((x #(a b a c))) (values (substitute 'b 'a x :count -1 :from-end t) x))
  #(a b a c)
  #(a b a c))

(deftest substitute-vector.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
278 279 280 281 282 283 284 285 286
        (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 'x '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)))))))
287 288 289 290
  t)

(deftest substitute-vector.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
291 292 293 294 295 296 297 298 299
        (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 'x '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)))))))
300 301 302 303
  t)

(deftest substitute-vector.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
304 305 306 307 308 309 310 311 312 313
        (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 'x '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))))))))
314 315 316 317
  t)

(deftest substitute-vector.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
318 319 320 321 322 323 324 325 326 327
        (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 'x '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))))))))
328 329 330 331
  t)

(deftest substitute-vector.19
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
332 333
         (x (copy-seq orig))
         (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2)))))
334
    (and (equalp orig x)
sds's avatar
sds committed
335
         result))
336 337 338 339
  #(1 2 x x x x x 8 9))

(deftest substitute-vector.20
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
340 341 342
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a)))))
343
    (and (equalp orig x)
sds's avatar
sds committed
344
         result))
345 346 347 348 349
  #(1 2 x 4 5 6 7 8 9))


(deftest substitute-vector.21
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
350 351 352 353
         (x (copy-seq orig))
         (c 5)
         (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a))
                             :from-end t)))
354
    (and (equalp orig x)
sds's avatar
sds committed
355
         result))
356 357 358 359
  #(1 2 3 4 5 6 7 x 9))

(deftest substitute-vector.22
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
360 361 362
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a)))))
363
    (and (equalp orig x)
sds's avatar
sds committed
364
         result))
365 366 367 368 369
  #(1 2 x 4 5 6 7 8 9))


(deftest substitute-vector.23
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
sds's avatar
sds committed
370 371 372 373
         (x (copy-seq orig))
         (c 5)
         (result (substitute 'x 9 x :test-not #'(lambda (a b) (incf c -2) (/= (+ b c) a))
                             :from-end t)))
374
    (and (equalp orig x)
sds's avatar
sds committed
375
         result))
376 377 378 379
  #(1 2 3 4 5 6 7 x 9))

(deftest substitute-vector.24
  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
380 381
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car)))
382
    (and (equalp orig x)
sds's avatar
sds committed
383
         result))
384
  #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
sds's avatar
sds committed
385

386 387
(deftest substitute-vector.25
  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
388 389
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5)))
390
    (and (equalp orig x)
sds's avatar
sds committed
391
         result))
392 393 394 395
  #((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))

(deftest substitute-vector.26
  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
396 397
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql))))
398
    (and (equalp orig x)
sds's avatar
sds committed
399
         result))
400 401 402 403
  #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))

(deftest substitute-vector.27
  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
sds's avatar
sds committed
404 405
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test-not #'eql)))
406
    (and (equalp orig x)
sds's avatar
sds committed
407
         result))
408 409
  #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))

410 411
(deftest substitute-vector.28
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
412 413
                       :fill-pointer 5))
         (result (substitute 'z 'a x)))
414 415 416 417 418
    result)
  #(z b z c b))

(deftest substitute-vector.29
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
419 420
                       :fill-pointer 5))
         (result (substitute 'z 'a x :from-end t)))
421 422 423 424 425
    result)
  #(z b z c b))

(deftest substitute-vector.30
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
426 427
                       :fill-pointer 5))
         (result (substitute 'z 'a x :count 1)))
428 429 430 431 432
    result)
  #(z b a c b))

(deftest substitute-vector.31
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
sds's avatar
sds committed
433 434
                       :fill-pointer 5))
         (result (substitute 'z 'a x :from-end t :count 1)))
435 436 437
    result)
  #(a b z c b))

438 439
(deftest substitute-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
440 441
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
442 443 444 445 446 447 448 449
    (values
     (substitute 'x '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-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
450 451
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
452 453 454 455 456 457
    (values
     (substitute 'x '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))

458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529
;;; Tests on strings

(deftest substitute-string.1
  (let ((x "")) (values (substitute #\b #\a x) x))
  "" "")

(deftest substitute-string.2
  (let ((x "abac")) (values (substitute #\b #\a x) x))
  "bbbc"
  "abac")

(deftest substitute-string.3
  (let ((x "abac")) (values (substitute #\b #\a x :count nil) x))
  "bbbc"
  "abac")

(deftest substitute-string.4
  (let ((x "abac")) (values (substitute #\b #\a x :count 2) x))
  "bbbc"
  "abac")

(deftest substitute-string.5
  (let ((x "abac")) (values (substitute #\b #\a x :count 1) x))
  "bbac"
  "abac")

(deftest substitute-string.6
  (let ((x "abac")) (values (substitute #\b #\a x :count 0) x))
  "abac"
  "abac")

(deftest substitute-string.7
  (let ((x "abac")) (values (substitute #\b #\a x :count -1) x))
  "abac"
  "abac")

(deftest substitute-string.8
  (let ((x "")) (values (substitute #\b #\a x :from-end t) x))
  "" "")

(deftest substitute-string.9
  (let ((x "abac")) (values (substitute #\b #\a x :from-end t) x))
  "bbbc"
  "abac")

(deftest substitute-string.10
  (let ((x "abac")) (values (substitute #\b #\a x :from-end t :count nil) x))
  "bbbc"
  "abac")

(deftest substitute-string.11
  (let ((x "abac")) (values (substitute #\b #\a x :count 2 :from-end t) x))
  "bbbc"
  "abac")

(deftest substitute-string.12
  (let ((x "abac")) (values (substitute #\b #\a x :count 1 :from-end t) x))
  "abbc"
  "abac")

(deftest substitute-string.13
  (let ((x "abac")) (values (substitute #\b #\a x :count 0 :from-end t) x))
  "abac"
  "abac")

(deftest substitute-string.14
  (let ((x "abac")) (values (substitute #\b #\a x :count -1 :from-end t) x))
  "abac"
  "abac")

(deftest substitute-string.15
  (loop for i from 0 to 9 always
sds's avatar
sds committed
530 531 532 533 534 535 536 537 538
        (loop for j from i to 10 always
              (let* ((orig "aaaaaaaaaa")
                     (x (copy-seq orig))
                     (y (substitute #\x #\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)))))))
539 540 541 542
  t)

(deftest substitute-string.16
  (loop for i from 0 to 9 always
sds's avatar
sds committed
543 544 545 546 547 548 549 550 551
        (loop for j from i to 10 always
              (let* ((orig "aaaaaaaaaa")
                     (x (copy-seq orig))
                     (y (substitute #\x #\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)))))))
552 553 554 555
  t)

(deftest substitute-string.17
  (loop for i from 0 to 9 always
sds's avatar
sds committed
556 557 558 559 560 561 562 563 564 565
        (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 #\x #\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))))))))
566 567 568 569
  t)

(deftest substitute-string.18
  (loop for i from 0 to 9 always
sds's avatar
sds committed
570 571 572 573 574 575 576 577 578 579
        (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 #\x #\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))))))))
580 581 582 583
  t)

(deftest substitute-string.19
  (let* ((orig "123456789")
sds's avatar
sds committed
584 585 586 587 588
         (x (copy-seq orig))
         (result (substitute #\x #\5 x :test #'(lambda (a b)
                                                 (setq a (read-from-string (string a)))
                                                 (setq b (read-from-string (string b)))
                                                 (<= (abs (- a b)) 2)))))
589
    (and (equalp orig x)
sds's avatar
sds committed
590
         result))
591 592 593 594
  "12xxxxx89")

(deftest substitute-string.20
  (let* ((orig "123456789")
sds's avatar
sds committed
595 596 597 598 599 600
         (x (copy-seq orig))
         (c -4)
         (result (substitute #\x #\5 x :test #'(lambda (a b)
                                                 (setq a (read-from-string (string a)))
                                                 (setq b (read-from-string (string b)))
                                                 (incf c 2) (= (+ b c) a)))))
601
    (and (equalp orig x)
sds's avatar
sds committed
602
         result))
603 604 605 606 607
  "12x456789")


(deftest substitute-string.21
  (let* ((orig "123456789")
sds's avatar
sds committed
608 609 610 611 612 613 614
         (x (copy-seq orig))
         (c 5)
         (result (substitute #\x #\9 x :test #'(lambda (a b)
                                                 (setq a (read-from-string (string a)))
                                                 (setq b (read-from-string (string b)))
                                                 (incf c -2) (= (+ b c) a))
                             :from-end t)))
615
    (and (equalp orig x)
sds's avatar
sds committed
616
         result))
617 618 619 620
  "1234567x9")

(deftest substitute-string.22
  (let* ((orig "123456789")
sds's avatar
sds committed
621 622 623 624 625 626
         (x (copy-seq orig))
         (c -4)
         (result (substitute #\x #\5 x :test-not #'(lambda (a b)
                                                     (setq a (read-from-string (string a)))
                                                     (setq b (read-from-string (string b)))
                                                     (incf c 2) (/= (+ b c) a)))))
627
    (and (equalp orig x)
sds's avatar
sds committed
628
         result))
629 630 631 632 633
  "12x456789")


(deftest substitute-string.23
  (let* ((orig "123456789")
sds's avatar
sds committed
634 635 636 637 638 639 640
         (x (copy-seq orig))
         (c 5)
         (result (substitute #\x #\9 x :test-not #'(lambda (a b)
                                                     (setq a (read-from-string (string a)))
                                                     (setq b (read-from-string (string b)))
                                                     (incf c -2) (/= (+ b c) a))
                             :from-end t)))
641
    (and (equalp orig x)
sds's avatar
sds committed
642
         result))
643 644 645 646
  "1234567x9")

(deftest substitute-string.24
  (let* ((orig "0102342015")
sds's avatar
sds committed
647 648
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit)))
649
    (and (equalp orig x)
sds's avatar
sds committed
650
         result))
651
  "a1a2342a15")
sds's avatar
sds committed
652

653 654
(deftest substitute-string.25
  (let* ((orig "0102342015")
sds's avatar
sds committed
655 656
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit :start 1 :end 6)))
657
    (and (equalp orig x)
sds's avatar
sds committed
658
         result))
659 660 661 662
  "01a2342015")

(deftest substitute-string.26
  (let* ((orig "0102342015")
sds's avatar
sds committed
663 664
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit :test (complement #'eql))))
665
    (and (equalp orig x)
sds's avatar
sds committed
666
         result))
667 668 669 670
  "0a0aaaa0aa")

(deftest substitute-string.27
  (let* ((orig "0102342015")
sds's avatar
sds committed
671 672
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit :test-not #'eql)))
673
    (and (equalp orig x)
sds's avatar
sds committed
674
         result))
675 676
   "0a0aaaa0aa")

677
(deftest substitute-string.28
678
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
679 680
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x)))
681 682 683 684
    result)
  "zbzcb")

(deftest substitute-string.29
685
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
686 687
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x :from-end t)))
688 689 690 691
    result)
  "zbzcb")

(deftest substitute-string.30
692
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
693 694
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x :count 1)))
695 696 697 698
    result)
  "zbacb")

(deftest substitute-string.31
699
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
sds's avatar
sds committed
700 701
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x :from-end t :count 1)))
702 703 704
    result)
  "abzcb")

705 706 707 708 709 710 711 712 713
(deftest substitute-string.32
  (do-special-strings
   (s "xyzabcxyzabc" nil)
   (assert (string= (substitute #\! #\a s) "xyz!bcxyz!bc"))
   (assert (string= (substitute #\! #\a s :count 1) "xyz!bcxyzabc"))
   (assert (string= (substitute #\! #\a s :count 1 :from-end t) "xyzabcxyz!bc"))
   (assert (string= s "xyzabcxyzabc")))
  nil)

714 715 716
;;; Tests on bit-vectors

(deftest substitute-bit-vector.1
717
  (let* ((orig #*)
sds's avatar
sds committed
718 719
         (x (copy-seq orig))
         (result (substitute 0 1 x)))
720
    (and (equalp orig x)
sds's avatar
sds committed
721
         result))
722 723
  #*)

724
(deftest substitute-bit-vector.2
725
  (let* ((orig #*)
sds's avatar
sds committed
726 727
         (x (copy-seq orig))
         (result (substitute 1 0 x)))
728
    (and (equalp orig x)
sds's avatar
sds committed
729
         result))
730 731
  #*)

732
(deftest substitute-bit-vector.3
733
  (let* ((orig #*010101)
sds's avatar
sds committed
734 735
         (x (copy-seq orig))
         (result (substitute 0 1 x)))
736
    (and (equalp orig x)
sds's avatar
sds committed
737
         result))
738 739
  #*000000)

740
(deftest substitute-bit-vector.4
741
  (let* ((orig #*010101)
sds's avatar
sds committed
742 743
         (x (copy-seq orig))
         (result (substitute 1 0 x)))
744
    (and (equalp orig x)
sds's avatar
sds committed
745
         result))
746 747
  #*111111)

748
(deftest substitute-bit-vector.5
749
  (let* ((orig #*010101)
sds's avatar
sds committed
750 751
         (x (copy-seq orig))
         (result (substitute 1 0 x :start 1)))
752
    (and (equalp orig x)
sds's avatar
sds committed
753
         result))
754
  #*011111)
sds's avatar
sds committed
755

756
(deftest substitute-bit-vector.6
757
  (let* ((orig #*010101)
sds's avatar
sds committed
758 759
         (x (copy-seq orig))
         (result (substitute 0 1 x :start 2 :end nil)))
760
    (and (equalp orig x)
sds's avatar
sds committed
761
         result))
762 763
  #*010000)

764
(deftest substitute-bit-vector.7
765
  (let* ((orig #*010101)
sds's avatar
sds committed
766 767
         (x (copy-seq orig))
         (result (substitute 1 0 x :end 4)))
768
    (and (equalp orig x)
sds's avatar
sds committed
769
         result))
770
  #*111101)
sds's avatar
sds committed
771

772
(deftest substitute-bit-vector.8
773
  (let* ((orig #*010101)
sds's avatar
sds committed
774 775
         (x (copy-seq orig))
         (result (substitute 0 1 x :end nil)))
776
    (and (equalp orig x)
sds's avatar
sds committed
777
         result))
778 779
  #*000000)

780
(deftest substitute-bit-vector.9
781
  (let* ((orig #*010101)
sds's avatar
sds committed
782 783
         (x (copy-seq orig))
         (result (substitute 0 1 x :end 3)))
784
    (and (equalp orig x)
sds's avatar
sds committed
785
         result))
786 787
  #*000101)

788
(deftest substitute-bit-vector.10
789
  (let* ((orig #*010101)
sds's avatar
sds committed
790 791
         (x (copy-seq orig))
         (result (substitute 0 1 x :start 2 :end 4)))
792
    (and (equalp orig x)
sds's avatar
sds committed
793
         result))
794 795
  #*010001)

796
(deftest substitute-bit-vector.11
797
  (let* ((orig #*010101)
sds's avatar
sds committed
798 799
         (x (copy-seq orig))
         (result (substitute 1 0 x :start 2 :end 4)))
800
    (and (equalp orig x)
sds's avatar
sds committed
801
         result))
802 803
  #*011101)

804
(deftest substitute-bit-vector.12
805
  (let* ((orig #*010101)
sds's avatar
sds committed
806 807
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 1)))
808
    (and (equalp orig x)
sds's avatar
sds committed
809
         result))
810 811
  #*110101)

812
(deftest substitute-bit-vector.13
813
  (let* ((orig #*010101)
sds's avatar
sds committed
814 815
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 0)))
816
    (and (equalp orig x)
sds's avatar
sds committed
817
         result))
818 819
  #*010101)

820
(deftest substitute-bit-vector.14
821
  (let* ((orig #*010101)
sds's avatar
sds committed
822 823
         (x (copy-seq orig))
         (result (substitute 1 0 x :count -1)))
824
    (and (equalp orig x)
sds's avatar
sds committed
825
         result))
826 827
  #*010101)

828
(deftest substitute-bit-vector.15
829
  (let* ((orig #*010101)
sds's avatar
sds committed
830 831
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 1 :from-end t)))
832
    (and (equalp orig x)
sds's avatar
sds committed
833
         result))
834 835
  #*010111)

836
(deftest substitute-bit-vector.16
837
  (let* ((orig #*010101)
sds's avatar
sds committed
838 839
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 0 :from-end t)))
840
    (and (equalp orig x)
sds's avatar
sds committed
841
         result))
842 843
  #*010101)

844
(deftest substitute-bit-vector.17
845
  (let* ((orig #*010101)
sds's avatar
sds committed
846 847
         (x (copy-seq orig))
         (result (substitute 1 0 x :count -1 :from-end t)))
848
    (and (equalp orig x)
sds's avatar
sds committed
849
         result))
850 851
  #*010101)

852
(deftest substitute-bit-vector.18
853
  (let* ((orig #*010101)
sds's avatar
sds committed
854 855
         (x (copy-seq orig))
         (result (substitute 1 0 x :count nil)))
856
    (and (equalp orig x)
sds's avatar
sds committed
857
         result))
858 859
  #*111111)

860
(deftest substitute-bit-vector.19
861
  (let* ((orig #*010101)
sds's avatar
sds committed
862 863
         (x (copy-seq orig))
         (result (substitute 1 0 x :count nil :from-end t)))
864
    (and (equalp orig x)
sds's avatar
sds committed
865
         result))
866 867
  #*111111)

868
(deftest substitute-bit-vector.20
869
  (loop for i from 0 to 9 always
sds's avatar
sds committed
870 871 872 873 874 875 876 877 878 879 880
        (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 1 0 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))))))))
881 882
  t)

883
(deftest substitute-bit-vector.21
884
  (loop for i from 0 to 9 always
sds's avatar
sds committed
885 886 887 888 889 890 891 892 893 894 895
        (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 0 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))))))))
896 897
  t)

898
(deftest substitute-bit-vector.22
899
  (let* ((orig #*0101010101)
sds's avatar
sds committed
900 901 902
         (x (copy-seq orig))
         (c 0)
         (result (substitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b))))))
903
    (and (equalp orig x)
sds's avatar
sds committed
904
         result))
905 906
  #*0111110101)

907
(deftest substitute-bit-vector.23
908
  (let* ((orig #*0101010101)
sds's avatar
sds committed
909 910 911 912
         (x (copy-seq orig))
         (c 0)
         (result (substitute 1 0 x :test-not #'(lambda (a b) (incf c)
                                                 (not (and (<= 2 c 5) (= a b)))))))
913
    (and (equalp orig x)
sds's avatar
sds committed
914
         result))
915 916
  #*0111110101)

917
(deftest substitute-bit-vector.24
918
  (let* ((orig #*0101010101)
sds's avatar
sds committed
919 920 921 922
         (x (copy-seq orig))
         (c 0)
         (result (substitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b)))
                             :from-end t)))
923
    (and (equalp orig x)
sds's avatar
sds committed
924
         result))
925 926
  #*0101011111)

927
(deftest substitute-bit-vector.25
928
  (let* ((orig #*0101010101)
sds's avatar
sds committed
929 930 931 932 933
         (x (copy-seq orig))
         (c 0)
         (result (substitute 1 0 x :test-not #'(lambda (a b) (incf c)
                                                 (not (and (<= 2 c 5) (= a b))))
                             :from-end t)))
934
    (and (equalp orig x)
sds's avatar
sds committed
935
         result))
936 937
  #*0101011111)

938
(deftest substitute-bit-vector.26
939
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
940 941
         (x (copy-seq orig))
         (result (substitute 1 1 x :key #'1+)))
942
    (and (equalp orig x)
sds's avatar
sds committed
943
         result))
944
  #*11111111111111111)
sds's avatar
sds committed
945

946
(deftest substitute-bit-vector.27
947
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
948 949
         (x (copy-seq orig))
         (result (substitute 1 1 x :key #'1+ :start 1 :end 10)))
950
    (and (equalp orig x)
sds's avatar
sds committed
951
         result))
952 953
  #*01111111111010110)

954
(deftest substitute-bit-vector.28
955
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
956 957
         (x (copy-seq orig))
         (result (substitute 0 1 x :key #'1+ :test (complement #'eql))))
958
    (and (equalp orig x)
sds's avatar
sds committed
959
         result))
960 961
  #*00000000000000000)

962
(deftest substitute-bit-vector.29
963
  (let* ((orig #*00111001011010110)
sds's avatar
sds committed
964 965
         (x (copy-seq orig))
         (result (substitute 0 1 x :key #'1+ :test-not #'eql)))
966
    (and (equalp orig x)
sds's avatar
sds committed
967
         result))
968
  #*00000000000000000)
969 970 971

(deftest substitute-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
972 973
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x)))
974 975 976 977 978
    result)
  #*11111)

(deftest substitute-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
979 980
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x :from-end t)))
981 982 983 984 985
    result)
  #*11111)

(deftest substitute-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
986 987
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x :count 1)))
988 989 990 991 992
    result)
  #*11011)

(deftest substitute-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
993 994
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x :from-end t :count 1)))
995 996
    result)
  #*01111)
997

998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022
(defharmless substitute.test-and-test-not.1
  (substitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql))

(defharmless substitute.test-and-test-not.2
  (substitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql))

(defharmless substitute.test-and-test-not.3
  (substitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql))

(defharmless substitute.test-and-test-not.4
  (substitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql))

(defharmless substitute.test-and-test-not.5
  (substitute #\b #\a (copy-seq "abcdab") :test #'eql :test-not #'eql))

(defharmless substitute.test-and-test-not.6
  (substitute #\b #\a (copy-seq "abcdab") :test-not #'eql :test #'eql))

(defharmless substitute.test-and-test-not.7
  (substitute 1 0 (copy-seq #*001101001) :test #'eql :test-not #'eql))

(defharmless substitute.test-and-test-not.8
  (substitute 0 1 (copy-seq #*1100110101) :test-not #'eql :test #'eql))


1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056
(deftest substitute.order.1
  (let ((i 0) a b c d e f g h)
    (values
     (substitute
      (progn (setf a (incf i)) 'a)
      (progn (setf b (incf i)) nil)
      (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.order.2
  (let ((i 0) a b c d e f g h)
    (values
     (substitute
      (progn (setf a (incf i)) 'a)
      (progn (setf b (incf i)) nil)
      (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)

1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068
;;; Keyword tests

(deftest substitute.allow-other-keys.1
  (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t :bad t)
  (1 2 a 3 1 a 3))

(deftest substitute.allow-other-keys.2
  (substitute 'a 0 (list 1 2 0 3 1 0 3) :bad t :allow-other-keys t)
  (1 2 a 3 1 a 3))

(deftest substitute.allow-other-keys.3
  (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t
sds's avatar
sds committed
1069
                  :allow-other-keys nil :bad t)
1070 1071 1072 1073
  (1 2 a 3 1 a 3))

(deftest substitute.allow-other-keys.4
  (substitute 'a 0 (list 1 2 0 3 1 0 3) :bad t
sds's avatar
sds committed
1074
                  :allow-other-keys t :allow-other-keys nil)
1075 1076 1077 1078
  (1 2 a 3 1 a 3))

(deftest substitute.allow-other-keys.5
  (substitute 'a 0 (list 1 2 0 3 1 0 3)
sds's avatar
sds committed
1079
                  :allow-other-keys t :key #'1-)
1080 1081 1082 1083 1084 1085 1086 1087
  (a 2 0 3 a 0 3))

(deftest substitute.keywords.6
  (substitute 'a 0 (list 1 2 0 3 1 0 3) :key #'1- :key #'identity)
  (a 2 0 3 a 0 3))

(deftest substitute.allow-other-keys.7
  (substitute 'a 0 (list 1 2 0 3 1 0 3) :allow-other-keys t
sds's avatar
sds committed
1088
                  :bad t :allow-other-keys nil)
1089 1090 1091 1092 1093 1094
  (1 2 a 3 1 a 3))

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

1095 1096
;;; Constant folding tests

1097 1098 1099 1100
(def-fold-test substitute.fold.1 (substitute 'z 'b '(a b c)))
(def-fold-test substitute.fold.2 (substitute 'z 'b #(a b c)))
(def-fold-test substitute.fold.3 (substitute 0 1 #*001101))
(def-fold-test substitute.fold.4 (substitute #\a #\b "abcebadfke"))
1101

1102 1103 1104
;;; Error cases

(deftest substitute.error.1
1105 1106
  (signals-error (substitute) program-error)
  t)
1107 1108

(deftest substitute.error.2
1109 1110
  (signals-error (substitute 'a) program-error)
  t)
1111 1112

(deftest substitute.error.3
1113 1114
  (signals-error (substitute 'a 'b) program-error)
  t)
1115 1116

(deftest substitute.error.4
1117 1118
  (signals-error (substitute 'a 'b nil 'bad t) program-error)
  t)
1119 1120

(deftest substitute.error.5
1121 1122
  (signals-error (substitute 'a 'b nil 'bad t :allow-other-keys nil) program-error)
  t)
1123 1124

(deftest substitute.error.6
1125 1126
  (signals-error (substitute 'a 'b nil :key) program-error)
  t)
1127 1128

(deftest substitute.error.7
1129 1130
  (signals-error (substitute 'a 'b nil 1 2) program-error)
  t)
1131 1132

(deftest substitute.error.8
1133 1134
  (signals-error (substitute 'a 'b (list 'a 'b 'c) :test #'identity) program-error)
  t)
1135 1136

(deftest substitute.error.9
1137 1138
  (signals-error (substitute 'a 'b (list 'a 'b 'c) :test-not #'identity) program-error)
  t)
1139 1140

(deftest substitute.error.10
1141 1142
  (signals-error (substitute 'a 'b (list 'a 'b 'c) :key #'cons) program-error)
  t)
1143 1144

(deftest substitute.error.11
1145 1146
  (signals-error (substitute 'a 'b (list 'a 'b 'c) :key #'car) type-error)
  t)
1147

1148 1149 1150
(deftest substitute.error.12
  (check-type-error #'(lambda (x) (substitute 'a 'b x)) #'sequencep)
  nil)