;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 21:37:56 2003
;;;; Contains: Tests of SUBST





(defvar *subst-tree-1* '(10 (30 20 10) (20 10) (10 20 30 40)))

(deftest subst.1
  (check-subst "Z" 30 (copy-tree *subst-tree-1*))
  (10 ("Z" 20 10) (20 10) (10 20 "Z" 40)))

(deftest subst.2
  (check-subst "A" 0 (copy-tree *subst-tree-1*))
  (10 (30 20 10) (20 10) (10 20 30 40)))

(deftest subst.3
  (check-subst "Z" 100 (copy-tree *subst-tree-1*) :test-not #'eql)
  "Z")

(deftest subst.4
  (check-subst 'grape 'dick
               '(melville wrote (moby dick)))
  (melville wrote (moby grape)))

(deftest subst.5
  (check-subst 'cha-cha-cha 'nil '(melville wrote (moby dick)))
  (melville wrote (moby dick . cha-cha-cha) . cha-cha-cha))

(deftest subst.6
  (check-subst
   '(1 2) '(foo . bar)
   '((foo . baz) (foo . bar) (bar . foo) (baz foo . bar))
   :test #'equal)
  ((foo . baz) (1 2) (bar . foo) (baz 1 2)))

(deftest subst.7
  (check-subst
   'foo "aaa"
   '((1 . 2) (4 . 5) (6 7 8 9 10 (11 12)))
   :key #'(lambda (x) (if (and (numberp x) (evenp x))
                          "aaa"
                        nil))
   :test #'string=)
  ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo))))

(deftest subst.8
  (check-subst
   'foo nil
   '((1 . 2) (4 . 5) (6 7 8 9 10 (11 12)))
   :key #'(lambda (x) (if (and (numberp x) (evenp x))
                          (copy-seq "aaa")
                        nil))
   :test-not #'equal)
  ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo))))

(deftest subst.9
  (check-subst 'a 'b
               (copy-tree '(a b c d a b))
               :key nil)
  (a a c d a a))

(deftest subst.10
  (check-subst 'x 10 (copy-tree '(1 2 10 20 30 4))
               :test #'(lambda (x y) (and (realp x) (realp y) (< x y))))
  (1 2 10 x x 4))

(deftest subst.11
  (check-subst 'x 10 (copy-tree '(1 2 10 20 30 4))
               :test-not #'(lambda (x y)
                             (not (and (realp x) (realp y) (< x y)))))
  (1 2 10 x x 4))

(defharmless subset.test-and-test-not.1
  (subst 'a 'b (list 'a 'b 'c 'd 'e) :test #'eq :test-not #'eq))

(defharmless subset.test-and-test-not.2
  (subst 'a 'b (list 'a 'b 'c 'd 'e) :test-not #'eq :test #'eq))


;;; Order of argument evaluation
(deftest subst.order.1
  (let ((i 0) v w x y z)
    (values
     (subst (progn (setf v (incf i)) 'b)
            (progn (setf w (incf i)) 'a)
            (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z)))
            :key (progn (setf y (incf i)) #'identity)
            :test (progn (setf z (incf i)) #'eql))
     i v w x y z))
  ((10 b . b) b b c ((b)) z)
  5 1 2 3 4 5)

(deftest subst.order.2
  (let ((i 0) v w x y z)
    (values
     (subst (progn (setf v (incf i)) 'b)
            (progn (setf w (incf i)) 'a)
            (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z)))
            :test-not (progn (setf y (incf i)) (complement #'eql))
            :key (progn (setf z (incf i)) #'identity)
            )
     i v w x y z))
  ((10 b . b) b b c ((b)) z)
  5 1 2 3 4 5)

;;; Const fold tests

(def-fold-test subst.fold.1 (subst 'a 'b '(a b c (a . b) . a)))

;;; Keyword tests for subst

(deftest subst.allow-other-keys.1
  (subst 'a 'b (list 'a 'b 'c) :bad t :allow-other-keys t)
  (a a c))

(deftest subst.allow-other-keys.2
  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t)
  (a a c))

(deftest subst.allow-other-keys.3
  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys nil)
  (a a c))

(deftest subst.allow-other-keys.4
  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t :bad t)
  (a a c))

(deftest subst.allow-other-keys.5
  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t :allow-other-keys nil
         :bad t)
  (a a c))

(deftest subst.keywords.6
  (subst 'a 'b (list 'a 'b 'c) :test #'eq :test (complement #'eq))
  (a a c))

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

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

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

(deftest subst.error.4
  (signals-error (subst 'a 'b nil :foo nil) program-error)
  t)

(deftest subst.error.5
  (signals-error (subst 'a 'b nil :test) program-error)
  t)

(deftest subst.error.6
  (signals-error (subst 'a 'b nil 1) program-error)
  t)

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

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

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

(deftest subst.error.10
  (signals-error (subst 'a 'b (list 'a 'b) :key #'equal) program-error)
  t)