;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 21:32:50 2003
;;;; Contains: Tests of SUBLIS

(in-package :cl-test)

(deftest sublis.1
  (check-sublis '((a b) g (d e 10 g h) 15 . g)
		'((e . e2) (g . 17)))
  ((a b) 17 (d e2 10 17 h) 15 . 17))

(deftest sublis.2
  (check-sublis '(f6 10 (f4 (f3 (f1 a b) (f1 a p)) (f2 a b)))
		'(((f1 a b) . (f2 a b)) ((f2 a b) . (f1 a b)))
		:test #'equal)
  (f6 10 (f4 (f3 (f2 a b) (f1 a p)) (f1 a b))))

(deftest sublis.3
  (check-sublis '(10 ((10 20 (a b c) 30)) (((10 20 30 40))))
		'((30 . "foo")))
  (10 ((10 20 (a b c) "foo")) (((10 20 "foo" 40)))))

(deftest sublis.4
  (check-sublis (sublis
		 (copy-tree '((a . 2) (b . 4) (c . 1)))
		 (copy-tree '(a b c d e (a b c a d b) f)))
		'((t . "yes"))
		:key #'(lambda (x) (and (typep x 'integer)
					(evenp x))))
  ("yes" "yes" 1 d e ("yes" "yes" 1 "yes" d "yes") f))

(deftest sublis.5
  (check-sublis '("fee" (("fee" "Fie" "foo"))
		  fie ("fee" "fie"))
		`((,(copy-seq "fie") . #\f)))
  ("fee" (("fee" "Fie" "foo")) fie ("fee" "fie")))

(deftest sublis.6
  (check-sublis '("fee" fie (("fee" "Fie" "foo") 1)
		  ("fee" "fie"))
		`((,(copy-seq "fie") . #\f))
		:test 'equal)
  ("fee" fie (("fee" "Fie" "foo") 1) ("fee" #\f)))

(deftest sublis.7
  (check-sublis '(("aa" a b)
		  (z "bb" d)
		  ((x . "aa")))
		`((,(copy-seq "aa") . 1)
		  (,(copy-seq "bb") . 2))
		:test 'equal
		:key #'(lambda (x) (if (consp x) (car x)
				     '*not-present*)))
  (1 (z . 2) ((x . "aa"))))

;; Check that a null key arg is ignored.

(deftest sublis.8
  (check-sublis 
   '(1 2 a b)
   '((1 . 2) (a . b))
   :key nil)
  (2 2 b b))

(deftest sublis.9
  (check-sublis  (list 0 3 8 20)
		 '((1 . x) (5 . y) (10 . z))
		:test #'(lambda (x y) (and (realp x) (realp y) (< x y))))
  (x y z 20))

(deftest sublis.10
  (check-sublis  (list 0 3 8 20)
		 '((1 . x) (5 . y) (10 . z))
		:test-not
		#'(lambda (x y) (not (and (realp x) (realp y) (< x y)))))
  (x y z 20))

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

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

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

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


;;; Keyword tests

(deftest sublis.allow-other-keys.1
  (sublis nil 'a :bad t :allow-other-keys t)
  a)

(deftest sublis.allow-other-keys.2
  (sublis nil 'a :allow-other-keys t :bad t)
  a)

(deftest sublis.allow-other-keys.3
  (sublis nil 'a :allow-other-keys t)
  a)

(deftest sublis.allow-other-keys.4
  (sublis nil 'a :allow-other-keys nil)
  a)

(deftest sublis.allow-other-keys.5
  (sublis nil 'a :allow-other-keys t :allow-other-keys t :bad t)
  a)

(deftest sublis.keywords.6
  (sublis '((1 . a)) (list 0 1 2) :key #'(lambda (x) (if (numberp x) (1+ x) x))
	  :key #'identity)
  (a 1 2))


;; Argument error cases

(deftest sublis.error.1
  (classify-error (sublis))
  program-error)

(deftest sublis.error.2
  (classify-error (sublis nil))
  program-error)

(deftest sublis.error.3
  (classify-error (sublis nil 'a :test))
  program-error)

(deftest sublis.error.4
  (classify-error (sublis nil 'a :bad-keyword t))
  program-error)

(deftest sublis.error.5
  (classify-error (sublis '((a . 1) (b . 2))
			  (list 'a 'b 'c 'd)
			  :test #'identity))
  program-error)

(deftest sublis.error.6
  (classify-error (sublis '((a . 1) (b . 2))
			  (list 'a 'b 'c 'd)
			  :key #'cons))
  program-error)

(deftest sublis.error.7
  (classify-error (sublis '((a . 1) (b . 2))
			  (list 'a 'b 'c 'd)
			  :test-not #'identity))
  program-error)

(deftest sublis.error.8
  (classify-error (sublis '((a . 1) . bad)
			  (list 'a 'b 'c 'd)))
  type-error)

(deftest sublis.shared
  (let* ((shared-piece (list 'a 'b))
	 (a (list shared-piece shared-piece)))
    (check-sublis a '((a . b) (b . a))))
  ((b a) (b a)))
