tree-equal.lsp 3.05 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jun 14 07:23:03 2003
;;;; Contains: Tests of TREE-EQUAL

6

7

8

9

10 11 12 13 14 15 16 17 18 19
(deftest tree-equal.1
  (notnot-mv (tree-equal 'a 'a))
  t)

(deftest tree-equal.2
  (tree-equal 'a 'b)
  nil)

(deftest tree-equal.3
  (notnot-mv (tree-equal (list 'a 'b (list 'c 'd))
sds's avatar
sds committed
20
                         (list 'a 'b (list 'c 'd))))
21 22 23 24 25 26 27 28 29
  t)

(deftest tree-equal.4
  (tree-equal '(a b c d) '(a b c e))
  nil)

(deftest tree-equal.5
  (notnot-mv (tree-equal 1 2 :test #'<))
  t)
sds's avatar
sds committed
30

31 32 33 34 35 36 37
(deftest tree-equal.6
  (notnot-mv (tree-equal 1 2 :test #'(lambda (x y) (values (< x y) t))))
  t)

(deftest tree-equal.7
  (tree-equal 1 2 :test #'>)
  nil)
sds's avatar
sds committed
38

39 40 41 42 43 44
(deftest tree-equal.8
  (tree-equal (list 1) 2 :test (constantly t))
  nil)

(deftest tree-equal.9
  (tree-equal (list 1) (list 2)
sds's avatar
sds committed
45 46
              :test #'(lambda (x y) (or (and (consp x) (consp y))
                                        (eql x y))))
47 48 49 50 51 52 53 54
  nil)

(deftest tree-equal.10
  (notnot-mv (tree-equal '(10 20 . 30) '(11 22 . 34) :test #'<))
  t)

(deftest tree-equal.11
  (let* ((x (list 'a 'b))
sds's avatar
sds committed
55 56
         (y (list x x))
         (z (list (list 'a 'b) (list 'a 'b))))
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
    (notnot-mv (tree-equal y z)))
  t)

(deftest tree-equal.12
  (tree-equal 'a '(a b))
  nil)

(deftest tree-equal.13
  (tree-equal '(a) '(a b))
  nil)

(deftest tree-equal.14
  (tree-equal '(a b) '(a))
  nil)

(deftest tree-equal.15
  (let ((x (vector 'a 'b 'c))
sds's avatar
sds committed
74
        (y (vector 'a' 'b 'c)))
75 76 77 78 79
    (tree-equal x y))
  nil)

(deftest tree-equal.16
  (let ((x (copy-seq ""))
sds's avatar
sds committed
80
        (y (copy-seq "")))
81 82 83
    (tree-equal x y))
  nil)

84 85 86 87 88 89
(defharmless tree-equal.test-and-test-not.1
  (tree-equal '(a b) '(a b) :test #'eql :test-not #'eql))

(defharmless tree-equal.test-and-test-not.2
  (tree-equal '(a b) '(a b) :test-not #'eql :test #'eql))

90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
;;; Keywords tests

(deftest tree-equal.allow-other-keys.1
  (notnot-mv (tree-equal '(a b) (list 'a 'b) :allow-other-keys nil))
  t)

(deftest tree-equal.allow-other-keys.2
  (tree-equal '(a b) (list 'a 'c) :allow-other-keys nil :test #'eql)
  nil)

(deftest tree-equal.allow-other-keys.3
  (tree-equal '(a b) (list 'a 'z) :allow-other-keys t :foo t)
  nil)

(deftest tree-equal.allow-other-keys.4
  (notnot-mv (tree-equal '(a b) (list 'a 'b) :allow-other-keys t
sds's avatar
sds committed
106
                         :allow-other-keys nil :foo t))
107 108
  t)

109 110
(deftest tree-equal.keywords.1
  (notnot-mv (tree-equal '(a . b) '(b . a)
sds's avatar
sds committed
111 112
                         :test (complement #'eql)
                         :test #'eql))
113 114 115
  t)


116 117 118
;;; Error tests

(deftest tree-equal.error.1
119 120
  (signals-error (tree-equal) program-error)
  t)
121 122

(deftest tree-equal.error.2
123 124
  (signals-error (tree-equal '(a b)) program-error)
  t)
125 126

(deftest tree-equal.error.3
127 128
  (signals-error (tree-equal '(a b) '(a b) (gensym) t) program-error)
  t)
129 130

(deftest tree-equal.error.4
131 132
  (signals-error (tree-equal '(a b) '(a b) (gensym) t :allow-other-keys nil) program-error)
  t)
133

134
(deftest tree-equal.error.5
135 136
  (signals-error (tree-equal '(a b) '(a b) :test #'identity) program-error)
  t)
137

138
(deftest tree-equal.error.6
139 140
  (signals-error (tree-equal '(a b) '(a b) :test #'(lambda (x y z) (eq x y))) program-error)
  t)