;-*- 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
        (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)))))))
  t)

(deftest substitute-list.16
  (loop for i from 0 to 9 always
        (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)))))))
  t)

(deftest substitute-list.17
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-list.18
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-list.19
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2)))))
    (and (equal orig x)
         result))
  (1 2 x x x x x 8 9))

(deftest substitute-list.20
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a)))))
    (and (equal orig x)
         result))
  (1 2 x 4 5 6 7 8 9))


(deftest substitute-list.21
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (c 5)
         (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a))
                             :from-end t)))
    (and (equal orig x)
         result))
  (1 2 3 4 5 6 7 x 9))

(deftest substitute-list.22
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a)))))
    (and (equal orig x)
         result))
  (1 2 x 4 5 6 7 8 9))


(deftest substitute-list.23
  (let* ((orig '(1 2 3 4 5 6 7 8 9))
         (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)))
    (and (equal orig x)
         result))
  (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)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car)))
    (and (equal orig x)
         result))
  ((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)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5)))
    (and (equal orig x)
         result))
  ((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)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql))))
    (and (equal orig x)
         result))
  ((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)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test-not #'eql)))
    (and (equal orig x)
         result))
  ((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))

;;; 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
        (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)))))))
  t)

(deftest substitute-vector.16
  (loop for i from 0 to 9 always
        (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)))))))
  t)

(deftest substitute-vector.17
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-vector.18
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-vector.19
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (result (substitute 'x 5 x :test #'(lambda (a b) (<= (abs (- a b)) 2)))))
    (and (equalp orig x)
         result))
  #(1 2 x x x x x 8 9))

(deftest substitute-vector.20
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test #'(lambda (a b) (incf c 2) (= (+ b c) a)))))
    (and (equalp orig x)
         result))
  #(1 2 x 4 5 6 7 8 9))


(deftest substitute-vector.21
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (c 5)
         (result (substitute 'x 9 x :test #'(lambda (a b) (incf c -2) (= (+ b c) a))
                             :from-end t)))
    (and (equalp orig x)
         result))
  #(1 2 3 4 5 6 7 x 9))

(deftest substitute-vector.22
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
         (x (copy-seq orig))
         (c -4)
         (result (substitute 'x 5 x :test-not #'(lambda (a b) (incf c 2) (/= (+ b c) a)))))
    (and (equalp orig x)
         result))
  #(1 2 x 4 5 6 7 8 9))


(deftest substitute-vector.23
  (let* ((orig #(1 2 3 4 5 6 7 8 9))
         (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)))
    (and (equalp orig x)
         result))
  #(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)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car)))
    (and (equalp orig x)
         result))
  #((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))

(deftest substitute-vector.25
  (let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :start 1 :end 5)))
    (and (equalp orig x)
         result))
  #((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)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test (complement #'eql))))
    (and (equalp orig x)
         result))
  #((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)))
         (x (copy-seq orig))
         (result (substitute '(a 10) 'a x :key #'car :test-not #'eql)))
    (and (equalp orig x)
         result))
  #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))

(deftest substitute-vector.28
  (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
                       :fill-pointer 5))
         (result (substitute 'z 'a x)))
    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)
                       :fill-pointer 5))
         (result (substitute 'z 'a x :from-end t)))
    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)
                       :fill-pointer 5))
         (result (substitute 'z 'a x :count 1)))
    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)
                       :fill-pointer 5))
         (result (substitute 'z 'a x :from-end t :count 1)))
    result)
  #(a b z c b))

(deftest substitute-vector.32
  (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
    (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)))
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
    (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))

;;; 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
        (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)))))))
  t)

(deftest substitute-string.16
  (loop for i from 0 to 9 always
        (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)))))))
  t)

(deftest substitute-string.17
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-string.18
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-string.19
  (let* ((orig "123456789")
         (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)))))
    (and (equalp orig x)
         result))
  "12xxxxx89")

(deftest substitute-string.20
  (let* ((orig "123456789")
         (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)))))
    (and (equalp orig x)
         result))
  "12x456789")


(deftest substitute-string.21
  (let* ((orig "123456789")
         (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)))
    (and (equalp orig x)
         result))
  "1234567x9")

(deftest substitute-string.22
  (let* ((orig "123456789")
         (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)))))
    (and (equalp orig x)
         result))
  "12x456789")


(deftest substitute-string.23
  (let* ((orig "123456789")
         (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)))
    (and (equalp orig x)
         result))
  "1234567x9")

(deftest substitute-string.24
  (let* ((orig "0102342015")
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit)))
    (and (equalp orig x)
         result))
  "a1a2342a15")

(deftest substitute-string.25
  (let* ((orig "0102342015")
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit :start 1 :end 6)))
    (and (equalp orig x)
         result))
  "01a2342015")

(deftest substitute-string.26
  (let* ((orig "0102342015")
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit :test (complement #'eql))))
    (and (equalp orig x)
         result))
  "0a0aaaa0aa")

(deftest substitute-string.27
  (let* ((orig "0102342015")
         (x (copy-seq orig))
         (result (substitute #\a #\1 x :key #'nextdigit :test-not #'eql)))
    (and (equalp orig x)
         result))
   "0a0aaaa0aa")

(deftest substitute-string.28
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x)))
    result)
  "zbzcb")

(deftest substitute-string.29
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x :from-end t)))
    result)
  "zbzcb")

(deftest substitute-string.30
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x :count 1)))
    result)
  "zbacb")

(deftest substitute-string.31
  (let* ((x (make-array '(10) :initial-contents "abacbadeaf"
                       :fill-pointer 5 :element-type 'character))
         (result (substitute #\z #\a x :from-end t :count 1)))
    result)
  "abzcb")

(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)

;;; Tests on bit-vectors

(deftest substitute-bit-vector.1
  (let* ((orig #*)
         (x (copy-seq orig))
         (result (substitute 0 1 x)))
    (and (equalp orig x)
         result))
  #*)

(deftest substitute-bit-vector.2
  (let* ((orig #*)
         (x (copy-seq orig))
         (result (substitute 1 0 x)))
    (and (equalp orig x)
         result))
  #*)

(deftest substitute-bit-vector.3
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 0 1 x)))
    (and (equalp orig x)
         result))
  #*000000)

(deftest substitute-bit-vector.4
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x)))
    (and (equalp orig x)
         result))
  #*111111)

(deftest substitute-bit-vector.5
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :start 1)))
    (and (equalp orig x)
         result))
  #*011111)

(deftest substitute-bit-vector.6
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 0 1 x :start 2 :end nil)))
    (and (equalp orig x)
         result))
  #*010000)

(deftest substitute-bit-vector.7
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :end 4)))
    (and (equalp orig x)
         result))
  #*111101)

(deftest substitute-bit-vector.8
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 0 1 x :end nil)))
    (and (equalp orig x)
         result))
  #*000000)

(deftest substitute-bit-vector.9
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 0 1 x :end 3)))
    (and (equalp orig x)
         result))
  #*000101)

(deftest substitute-bit-vector.10
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 0 1 x :start 2 :end 4)))
    (and (equalp orig x)
         result))
  #*010001)

(deftest substitute-bit-vector.11
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :start 2 :end 4)))
    (and (equalp orig x)
         result))
  #*011101)

(deftest substitute-bit-vector.12
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 1)))
    (and (equalp orig x)
         result))
  #*110101)

(deftest substitute-bit-vector.13
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 0)))
    (and (equalp orig x)
         result))
  #*010101)

(deftest substitute-bit-vector.14
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count -1)))
    (and (equalp orig x)
         result))
  #*010101)

(deftest substitute-bit-vector.15
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 1 :from-end t)))
    (and (equalp orig x)
         result))
  #*010111)

(deftest substitute-bit-vector.16
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count 0 :from-end t)))
    (and (equalp orig x)
         result))
  #*010101)

(deftest substitute-bit-vector.17
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count -1 :from-end t)))
    (and (equalp orig x)
         result))
  #*010101)

(deftest substitute-bit-vector.18
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count nil)))
    (and (equalp orig x)
         result))
  #*111111)

(deftest substitute-bit-vector.19
  (let* ((orig #*010101)
         (x (copy-seq orig))
         (result (substitute 1 0 x :count nil :from-end t)))
    (and (equalp orig x)
         result))
  #*111111)

(deftest substitute-bit-vector.20
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-bit-vector.21
  (loop for i from 0 to 9 always
        (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))))))))
  t)

(deftest substitute-bit-vector.22
  (let* ((orig #*0101010101)
         (x (copy-seq orig))
         (c 0)
         (result (substitute 1 0 x :test #'(lambda (a b) (incf c) (and (<= 2 c 5) (= a b))))))
    (and (equalp orig x)
         result))
  #*0111110101)

(deftest substitute-bit-vector.23
  (let* ((orig #*0101010101)
         (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)))))))
    (and (equalp orig x)
         result))
  #*0111110101)

(deftest substitute-bit-vector.24
  (let* ((orig #*0101010101)
         (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)))
    (and (equalp orig x)
         result))
  #*0101011111)

(deftest substitute-bit-vector.25
  (let* ((orig #*0101010101)
         (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)))
    (and (equalp orig x)
         result))
  #*0101011111)

(deftest substitute-bit-vector.26
  (let* ((orig #*00111001011010110)
         (x (copy-seq orig))
         (result (substitute 1 1 x :key #'1+)))
    (and (equalp orig x)
         result))
  #*11111111111111111)

(deftest substitute-bit-vector.27
  (let* ((orig #*00111001011010110)
         (x (copy-seq orig))
         (result (substitute 1 1 x :key #'1+ :start 1 :end 10)))
    (and (equalp orig x)
         result))
  #*01111111111010110)

(deftest substitute-bit-vector.28
  (let* ((orig #*00111001011010110)
         (x (copy-seq orig))
         (result (substitute 0 1 x :key #'1+ :test (complement #'eql))))
    (and (equalp orig x)
         result))
  #*00000000000000000)

(deftest substitute-bit-vector.29
  (let* ((orig #*00111001011010110)
         (x (copy-seq orig))
         (result (substitute 0 1 x :key #'1+ :test-not #'eql)))
    (and (equalp orig x)
         result))
  #*00000000000000000)

(deftest substitute-bit-vector.30
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x)))
    result)
  #*11111)

(deftest substitute-bit-vector.31
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x :from-end t)))
    result)
  #*11111)

(deftest substitute-bit-vector.32
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x :count 1)))
    result)
  #*11011)

(deftest substitute-bit-vector.33
  (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
                       :fill-pointer 5 :element-type 'bit))
         (result (substitute 1 0 x :from-end t :count 1)))
    result)
  #*01111)

(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))


(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)

;;; 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
                  :allow-other-keys nil :bad t)
  (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
                  :allow-other-keys t :allow-other-keys nil)
  (1 2 a 3 1 a 3))

(deftest substitute.allow-other-keys.5
  (substitute 'a 0 (list 1 2 0 3 1 0 3)
                  :allow-other-keys t :key #'1-)
  (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
                  :bad t :allow-other-keys nil)
  (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))

;;; Constant folding tests

(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"))

;;; Error cases

(deftest substitute.error.1
  (signals-error (substitute) program-error)
  t)

(deftest substitute.error.2
  (signals-error (substitute 'a) program-error)
  t)

(deftest substitute.error.3
  (signals-error (substitute 'a 'b) program-error)
  t)

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

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

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

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

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

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

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

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

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