;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Aug 26 23:55:29 2002
;;;; Contains: Tests for MISMATCH

(in-package :cl-test)

(deftest mismatch-list.1
  (mismatch '() '(a b c))
  0)

(deftest mismatch-list.2
  (mismatch '(a b c d) '())
  0)

(deftest mismatch-list.3
  (mismatch '(a b c) '(a b c))
  nil)

(deftest mismatch-list.4
  (mismatch '(a b c) '(a b d))
  2)

(deftest mismatch-list.5
  (mismatch '(a b c) '(b c) :start1 1)
  nil)

(deftest mismatch-list.6
  (mismatch '(a b c d) '(z b c e) :start1 1 :start2 1)
  3)

(deftest mismatch-list.7
  (mismatch '(a b c d) '(z b c e) :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-list.8
  (mismatch '(1 2 3 4) '(5 6 7 8) :test #'(lambda (x y) (= x (- y 4))))
  nil)

(deftest mismatch-list.9
  (mismatch '(1 2 3 4) '(5 6 17 8) :test #'(lambda (x y) (= x (- y 4))))
  2)

(deftest mismatch-list.10
  (mismatch '(1 2 3 4) '(10 11 7 123) :test-not #'(lambda (x y) (= x (- y 4))))
  2)

(deftest mismatch-list.11
  (mismatch '(1 2 3 4) '(5 6 17 8) :key #'evenp)
  nil)

(deftest mismatch-list.12
  (mismatch '(1 2 3 4) '(5 6 12 8) :key 'oddp)
  2)

(deftest mismatch-list.13
  (mismatch '(1 2 3 4) '(1 2 3 4) :test 'eql)
  nil)

(deftest mismatch-list.14
  (mismatch '(1 2 3 4) '(5 6 7 8) :test-not 'eql)
  nil)

(deftest mismatch-list.15
  (mismatch '(a b c d e f g h i j k) '(a b c c e f g h z j k))
  3)

(deftest mismatch-list.16
  (mismatch '(a b c d e f g h i j k) '(a b c c y f g h z j k) :from-end t)
  9)

(deftest mismatch-list.17
  (mismatch '(a b c) '(a b c a b c d) :from-end t)
  3)

(deftest mismatch-list.18
  (mismatch '(a b c a b c d) '(a b c) :from-end t)
  7)

(deftest mismatch-list.19
  (mismatch '(1 1 1) '(2 2 2 2 2 1 2 2) :from-end t :test-not 'eql)
  1)

(deftest mismatch-list.20
  (mismatch '(1 1 1 1 1 1 1) '(2 3 3) :from-end t :key #'evenp)
  5)

(deftest mismatch-list.21
  (mismatch '(1 1 1) '(2 2 2 2 2 1 2 2) :from-end t :test-not #'equal)
  1)

(deftest mismatch-list.22
  (mismatch '(1 1 1 1 1 1 1) '(2 3 3) :from-end t :key 'evenp)
  5)

;;; tests on vectors

(deftest mismatch-vector.1
  (mismatch #() #(a b c))
  0)

(deftest mismatch-vector.2
  (mismatch #(a b c d) #())
  0)

(deftest mismatch-vector.3
  (mismatch #(a b c) #(a b c))
  nil)

(deftest mismatch-vector.4
  (mismatch #(a b c) #(a b d))
  2)

(deftest mismatch-vector.5
  (mismatch #(a b c) #(b c) :start1 1)
  nil)

(deftest mismatch-vector.6
  (mismatch #(a b c d) #(z b c e) :start1 1 :start2 1)
  3)

(deftest mismatch-vector.7
  (mismatch #(a b c d) #(z b c e) :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-vector.8
  (mismatch #(1 2 3 4) #(5 6 7 8) :test #'(lambda (x y) (= x (- y 4))))
  nil)

(deftest mismatch-vector.9
  (mismatch #(1 2 3 4) #(5 6 17 8) :test #'(lambda (x y) (= x (- y 4))))
  2)

(deftest mismatch-vector.10
  (mismatch #(1 2 3 4) #(10 11 7 123) :test-not #'(lambda (x y) (= x (- y 4))))
  2)

(deftest mismatch-vector.11
  (mismatch #(1 2 3 4) #(5 6 17 8) :key #'evenp)
  nil)

(deftest mismatch-vector.12
  (mismatch #(1 2 3 4) #(5 6 12 8) :key 'oddp)
  2)

(deftest mismatch-vector.13
  (mismatch #(1 2 3 4) #(1 2 3 4) :test 'eql)
  nil)

(deftest mismatch-vector.14
  (mismatch #(1 2 3 4) #(5 6 7 8) :test-not 'eql)
  nil)

(deftest mismatch-vector.15
  (mismatch #(a b c d e f g h i j k) #(a b c c e f g h z j k))
  3)

(deftest mismatch-vector.16
  (mismatch #(a b c d e f g h i j k) #(a b c c y f g h z j k) :from-end t)
  9)

(deftest mismatch-vector.17
  (mismatch #(a b c) #(a b c a b c d) :from-end t)
  3)

(deftest mismatch-vector.18
  (mismatch #(a b c a b c d) #(a b c) :from-end t)
  7)

(deftest mismatch-vector.19
  (mismatch #(1 1 1) #(2 2 2 2 2 1 2 2) :from-end t :test-not 'eql)
  1)

(deftest mismatch-vector.20
  (mismatch #(1 1 1 1 1 1 1) #(2 3 3) :from-end t :key #'evenp)
  5)

(deftest mismatch-vector.21
  (mismatch #(1 1 1) #(2 2 2 2 2 1 2 2) :from-end t :test-not #'equal)
  1)

(deftest mismatch-vector.22
  (mismatch #(1 1 1 1 1 1 1) #(2 3 3) :from-end t :key 'evenp)
  5)

(deftest mismatch-vector.23
  (let ((a (make-array '(9) :initial-contents '(1 2 3 4 5 6 7 8 9)
                       :fill-pointer 5)))
    (values
     (mismatch '(1 2 3 4 5) a)
     (mismatch '(1 2 3 4 5) a :from-end t)
     (mismatch '(1 2 3 4) a)
     (mismatch '(1 2 3 4 5 6) a)
     (mismatch '(6 7 8 9) a :from-end t)
     (mismatch '(2 3 4 5) a :from-end t)))
  nil nil 4 5 4 0)

(deftest mismatch-vector.24
  (let ((m (make-array '(6) :initial-contents '(1 2 3 4 5 6)
                       :fill-pointer 4))
        (a '(1 2 3 4 5)))
    (list
     (mismatch m a)
     (mismatch m a :from-end t)
     (setf (fill-pointer m) 5)
     (mismatch m a)
     (mismatch m a :from-end t)
     (setf (fill-pointer m) 6)
     (mismatch m a)
     (mismatch m a :from-end t)))
  (4 4 5 nil nil 6 5 6))

;;; tests on bit vectors

(deftest mismatch-bit-vector.1
  (mismatch "" #*111)
  0)

(deftest mismatch-bit-vector.1a
  (mismatch '() #*111)
  0)

(deftest mismatch-bit-vector.1b
  (mismatch "" '(1 1 1))
  0)

(deftest mismatch-bit-vector.2
  (mismatch #*1010 #*)
  0)

(deftest mismatch-bit-vector.2a
  (mismatch #*1010 '())
  0)

(deftest mismatch-bit-vector.2b
  (mismatch '(1 0 1 0) #*)
  0)

(deftest mismatch-bit-vector.3
  (mismatch #*101 #*101)
  nil)

(deftest mismatch-bit-vector.4
  (mismatch #*101 #*100)
  2)

(deftest mismatch-bit-vector.5
  (mismatch #*101  #*01 :start1 1)
  nil)

(deftest mismatch-bit-vector.6
  (mismatch #*0110 #*0111 :start1 1 :start2 1)
  3)

(deftest mismatch-bit-vector.7
  (mismatch #*0110 #*0111 :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-bit-vector.7a
  (mismatch '(0 1 1 0) #*0111 :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-bit-vector.7b
  (mismatch #*0110 '(0 1 1 1) :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-bit-vector.8
  (mismatch #*1001 #*0110 :test #'(lambda (x y) (= x (- 1 y))))
  nil)

(deftest mismatch-bit-vector.8a
  (mismatch #*1001 '(5 4 4 5) :test #'(lambda (x y) (= x (- y 4))))
  nil)

(deftest mismatch-bit-vector.9
  (mismatch #*1001 '(5 4 17 5) :test #'(lambda (x y) (= x (- y 4))))
  2)

(deftest mismatch-bit-vector.9a
  (mismatch '(5 4 17 5) #*1001 :test #'(lambda (x y) (= y (- x 4))))
  2)

(deftest mismatch-bit-vector.9b
  (mismatch #*0100 #*1001 :test #'(lambda (x y) (= x (- 1 y))))
  2)

(deftest mismatch-bit-vector.10
  (mismatch #*1001 '(10 11 4 123) :test-not #'(lambda (x y) (= x (- y 4))))
  2)

(deftest mismatch-bit-vector.10a
  (mismatch #*1001 '(10 11 100 123) :test-not #'(lambda (x y) (= x (- y 4))))
  nil)

(deftest mismatch-bit-vector.11
  (mismatch #*1010 '(5 6 17 8) :key #'evenp)
  nil)

(deftest mismatch-bit-vector.11a
  (mismatch '(5 6 17 8) #*1010 :key #'evenp)
  nil)

(deftest mismatch-bit-vector.11b
  (mismatch #*0101 #*1010 :key #'evenp :test-not 'eql)
  nil)

(deftest mismatch-bit-vector.11c
  (mismatch '(5 6 17 8) #*10101 :key #'evenp)
  4)

(deftest mismatch-bit-vector.11d
  (mismatch '(5 6 17 8 100) #*1010 :key #'evenp)
  4)

(deftest mismatch-bit-vector.12
  (mismatch #*1010 #*1000 :key 'oddp)
  2)

(deftest mismatch-bit-vector.12a
  (mismatch #*1010 '(5 6 8 8) :key 'oddp)
  2)

(deftest mismatch-bit-vector.12b
  (mismatch '(5 6 8 8) #*1010 :key 'oddp)
  2)

(deftest mismatch-bit-vector.13
  (mismatch #*0001 #*0001 :test 'eql)
  nil)

(deftest mismatch-bit-vector.14
  (mismatch '#*10001 #*01110 :test-not 'eql)
  nil)

(deftest mismatch-bit-vector.15
  (mismatch #*00100010100 #*00110010000)
  3)

(deftest mismatch-bit-vector.16
  (mismatch #*00100010100 #*00110010000 :from-end t)
  9)

(deftest mismatch-bit-vector.17
  (mismatch #*001 #*0010010 :from-end t)
  3)

(deftest mismatch-bit-vector.18
  (mismatch #*0010010 #*001 :from-end t)
  7)

(deftest mismatch-bit-vector.19
  (mismatch #*000 #*11111011 :from-end t :test-not 'eql)
  1)

(deftest mismatch-bit-vector.20
  (mismatch #*1111111 '(2 3 3) :from-end t :key #'evenp)
  5)

(deftest mismatch-bit-vector.21
  (mismatch #*111 #*00000100 :from-end t :test-not #'equal)
  1)

(deftest mismatch-bit-vector.22
  (mismatch #*1111111 '(2 3 3) :from-end t :key 'evenp)
  5)

(deftest mismatch-bit-vector.23
  (let ((a (make-array '(9) :initial-contents #*001011000
                       :fill-pointer 5
                       :element-type 'bit)))
    (values
     (mismatch #*00101 a)
     (mismatch #*00101 a :from-end t)
     (mismatch #*0010 a)
     (mismatch #*001011 a)
     (mismatch #*1000 a :from-end t)
     (mismatch #*0010 a :from-end t)))
  nil nil 4 5 4 4)

(deftest mismatch-bit-vector.24
  (let ((m (make-array '(6) :initial-contents #*001011
                       :fill-pointer 4
                       :element-type 'bit))
        (a #*00101))
    (list
     (mismatch m a)
     (mismatch m a :from-end t)
     (setf (fill-pointer m) 5)
     (mismatch m a)
     (mismatch m a :from-end t)
     (setf (fill-pointer m) 6)
     (mismatch m a)
     (mismatch m a :from-end t)))
  (4 4 5 nil nil 6 5 5))

;;; tests on strings

(deftest mismatch-string.1
  (mismatch "" "111")
  0)

(deftest mismatch-string.1a
  (mismatch '() "111")
  0)

(deftest mismatch-string.1b
  (mismatch "" '(1 1 1))
  0)

(deftest mismatch-string.2
  (mismatch "1010" "")
  0)

(deftest mismatch-string.2a
  (mismatch "1010" '())
  0)

(deftest mismatch-string.2b
  (mismatch '(1 0 1 0) "")
  0)

(deftest mismatch-string.3
  (mismatch "101" "101")
  nil)

(deftest mismatch-string.4
  (mismatch "101" "100")
  2)

(deftest mismatch-string.5
  (mismatch "101" "01" :start1 1)
  nil)

(deftest mismatch-string.6
  (mismatch "0110" "0111" :start1 1 :start2 1)
  3)

(deftest mismatch-string.7
  (mismatch "0110" "0111" :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-string.7a
  (mismatch '(#\0 #\1 #\1 #\0) "0111" :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-string.7b
  (mismatch "0110" '(#\0 #\1 #\1 #\1) :start1 1 :start2 1 :end1 3 :end2 3)
  nil)

(deftest mismatch-string.8
  (mismatch "1001" "0110" :test #'(lambda (x y) (eql x (if (eql y #\0)
                                                           #\1 #\0))))
  nil)

(deftest mismatch-string.8a
  (mismatch "1001" '(5 4 4 5) :test #'(lambda (x y)
                                        (setq x (read-from-string (string x)))
                                        (= x (- y 4))))
  nil)

(deftest mismatch-string.9
  (mismatch "1001" '(5 4 17 5) :test #'(lambda (x y)
                                         (setq x (read-from-string (string x)))
                                         (= x (- y 4))))
  2)

(deftest mismatch-string.9a
  (mismatch '(5 4 17 5) "1001" :test #'(lambda (x y)
                                         (setq y (read-from-string (string y)))
                                         (= y (- x 4))))
  2)

(deftest mismatch-string.9b
  (mismatch "0100" "1001" :test #'(lambda (x y) (eql x (if (eql y #\0) #\1 #\0))))
  2)

(deftest mismatch-string.10
  (mismatch "1001" "0049" :test-not #'(lambda (x y)
                                         (setq x (read-from-string (string x)))
                                         (setq y (read-from-string (string y)))
                                         (eql x (- y 4))))
  2)

(deftest mismatch-string.10a
  (mismatch "1001" "3333" :test-not #'(lambda (x y)
                                        (setq x (read-from-string (string x)))
                                        (setq y (read-from-string (string y)))
                                        (eql x (- y 4))))
  nil)

(deftest mismatch-string.11
  (mismatch "1010" "5678"  :key #'evendigitp)
  nil)

(deftest mismatch-string.11a
  (mismatch "5678" "1010" :key #'odddigitp)
  nil)

(deftest mismatch-string.11b
  (mismatch "0101" "1010" :key #'evendigitp :test-not 'eql)
  nil)

(deftest mismatch-string.11c
  (mismatch "5678" "10101" :key #'evendigitp)
  4)

(deftest mismatch-string.11d
  (mismatch "56122" "1010" :key #'evendigitp)
  4)

(deftest mismatch-string.11e
  (mismatch "0101" '(#\1 #\0 #\1 #\0) :key #'evendigitp :test-not 'eql)
  nil)

(deftest mismatch-string.12
  (mismatch "1010" "1000" :key 'odddigitp)
  2)

(deftest mismatch-string.12a
  (mismatch "1010" "5688" :key 'odddigitp)
  2)

(deftest mismatch-string.12b
  (mismatch '(#\5 #\6 #\8 #\8) "1010" :key 'odddigitp)
  2)

(deftest mismatch-string.13
  (mismatch "0001" "0001" :test 'eql)
  nil)

(deftest mismatch-string.14
  (mismatch "10001" "01110" :test-not 'eql)
  nil)

(deftest mismatch-string.15
  (mismatch "00100010100" "00110010000")
  3)

(deftest mismatch-string.16
  (mismatch "00100010100" "00110010000" :from-end t)
  9)

(deftest mismatch-string.17
  (mismatch "001" "0010010" :from-end t)
  3)

(deftest mismatch-string.18
  (mismatch "0010010" "001" :from-end t)
  7)

(deftest mismatch-string.19
  (mismatch "000" "11111011" :from-end t :test-not 'eql)
  1)

(deftest mismatch-string.20
  (mismatch "1111111" "233" :from-end t :key #'evendigitp)
  5)

(deftest mismatch-string.20a
  (mismatch "1111111" '(#\2 #\3 #\3) :from-end t :key #'evendigitp)
  5)

(deftest mismatch-string.21
  (mismatch "111" "00000100" :from-end t :test-not #'equal)
  1)

(deftest mismatch-string.22
  (mismatch "1111111" "233" :from-end t :key 'evendigitp)
  5)

(deftest mismatch-string.23
  (let ((a (make-array '(9) :initial-contents "123456789"
                       :fill-pointer 5
                       :element-type 'character)))
    (values
     (mismatch "12345" a)
     (mismatch "12345" a :from-end t)
     (mismatch "1234" a)
     (mismatch "123456" a)
     (mismatch "6789" a :from-end t)
     (mismatch "2345" a :from-end t)))
  nil nil 4 5 4 0)

(deftest mismatch-string.24
  (let ((m (make-array '(6) :initial-contents "123456"
                       :fill-pointer 4
                       :element-type 'character))
        (a "12345"))
    (list
     (mismatch m a)
     (mismatch m a :from-end t)
     (setf (fill-pointer m) 5)
     (mismatch m a)
     (mismatch m a :from-end t)
     (setf (fill-pointer m) 6)
     (mismatch m a)
     (mismatch m a :from-end t)))
  (4 4 5 nil nil 6 5 6))

(deftest mistmatch-string.25
  (let ((s0 "12345")
        (s1 "123A")
        (s2 "245"))
    (do-special-strings
     (s s0 nil)
     (assert (null (mismatch s s0)))
     (assert (null (mismatch s0 s)))
     (assert (null (mismatch s s0 :from-end t)))
     (assert (null (mismatch s0 s :from-end t)))
     (assert (eql (mismatch s s1) 3))
     (assert (eql (mismatch s1 s) 3))
     ))
  nil)

;;; test and test-not tests

(defharmless mismatch.test-and-test-not.1
  (mismatch '(1 2 3) '(1 2 4) :test #'eql :test-not #'eql))

(defharmless mismatch.test-and-test-not.2
  (mismatch '(1 2 3) '(1 2 4) :test-not #'eql :test #'eql))

(defharmless mismatch.test-and-test-not.3
  (mismatch #(1 2 3) #(1 2 4) :test #'eql :test-not #'eql))

(defharmless mismatch.test-and-test-not.4
  (mismatch #(1 2 3) #(1 2 4) :test-not #'eql :test #'eql))

(defharmless mismatch.test-and-test-not.5
  (mismatch "abc" "abd" :test #'eql :test-not #'eql))

(defharmless mismatch.test-and-test-not.6
  (mismatch "abc" "abd" :test-not #'eql :test #'eql))

(defharmless mismatch.test-and-test-not.7
  (mismatch #*011 #*010 :test #'eql :test-not #'eql))

(defharmless mismatch.test-and-test-not.8
  (mismatch #*011 #*010 :test-not #'eql :test #'eql))

;;; Keyword tests

(deftest mismatch.allow-other-keys.1
  (mismatch "1234" "1244" :allow-other-keys t :bad t)
  2)

(deftest mismatch.allow-other-keys.2
  (mismatch "1234" "1244" :bad t :allow-other-keys t)
  2)

(deftest mismatch.allow-other-keys.3
  (mismatch "1234" "1244" :bad t :allow-other-keys t :allow-other-keys nil)
  2)

(deftest mismatch.allow-other-keys.4
  (mismatch "1234" "1244" :allow-other-keys t :bad t
            :allow-other-keys nil)
  2)

(deftest mismatch.allow-other-keys.5
  (mismatch "1234" "1244" :allow-other-keys t
            :allow-other-keys nil
            :bad t)
  2)

(deftest mismatch.keywords.6
  (mismatch "1234" "1244" :test #'equal :test (complement #'equal))
  2)

(deftest mismatch.allow-other-keys.7
  (mismatch "1234" "1244" :bad t :allow-other-keys t
            :test (complement #'equal))
  0)

;;; Order of evaluation

(deftest mismatch.order.1
  (let ((i 0) a b)
    (values
     (mismatch (progn (setf a (incf i)) "abcd")
               (progn (setf b (incf i)) "abzd"))
     i a b))
  2 2 1 2)

(deftest mismatch.order.2
  (let ((i 0) a b c d e f g h j)
    (values
     (mismatch (progn (setf a (incf i)) "abcdef")
               (progn (setf b (incf i)) "abcdef")
               :key (progn (setf c (incf i)) #'identity)
               :test (progn (setf d (incf i)) #'equal)
               :start1 (progn (setf e (incf i)) 1)
               :start2 (progn (setf f (incf i)) 1)
               :end1 (progn (setf g (incf i)) 4)
               :end2 (progn (setf h (incf i)) 4)
               :from-end (setf j (incf i)))
     i a b c d e f g h j))
  nil 9 1 2 3 4 5 6 7 8 9)

(deftest mismatch.order.3
  (let ((i 0) a b c d e f g h j)
    (values
     (mismatch (progn (setf a (incf i)) "abcdef")
               (progn (setf b (incf i)) "abcdef")
               :from-end (setf c (incf i))
               :end2 (progn (setf d (incf i)) 4)
               :end1 (progn (setf e (incf i)) 4)
               :start2 (progn (setf f (incf i)) 1)
               :start1 (progn (setf g (incf i)) 1)
               :test (progn (setf h (incf i)) #'equal)
               :key (progn (setf j (incf i)) #'identity))
     i a b c d e f g h j))
  nil 9 1 2 3 4 5 6 7 8 9)


;;; Error cases

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

(deftest mismatch.error.2
  (signals-error (mismatch nil) program-error)
  t)

(deftest mismatch.error.3
  (signals-error (mismatch nil nil :bad t) program-error)
  t)

(deftest mismatch.error.4
  (signals-error (mismatch nil nil :bad t :allow-other-keys nil)
                 program-error)
  t)

(deftest mismatch.error.5
  (signals-error (mismatch nil nil :key) program-error)
  t)

(deftest mismatch.error.6
  (signals-error (mismatch nil nil 1 2) program-error)
  t)

(deftest mismatch.error.7
  (signals-error (mismatch '(a b) '(a b) :test #'identity) program-error)
  t)

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

(deftest mismatch.error.9
  (signals-error (mismatch '(a b) '(a b) :key #'car) type-error)
  t)

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