subst.lsp 4.6 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 21:37:56 2003
;;;; Contains: Tests of SUBST

6

7

8

9

10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
(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
sds's avatar
sds committed
26
               '(melville wrote (moby dick)))
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
  (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))
sds's avatar
sds committed
45 46
                          "aaa"
                        nil))
47 48 49 50 51 52 53 54
   :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))
sds's avatar
sds committed
55 56
                          (copy-seq "aaa")
                        nil))
57 58 59 60 61
   :test-not #'equal)
  ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo))))

(deftest subst.9
  (check-subst 'a 'b
sds's avatar
sds committed
62 63
               (copy-tree '(a b c d a b))
               :key nil)
64 65
  (a a c d a a))

66 67
(deftest subst.10
  (check-subst 'x 10 (copy-tree '(1 2 10 20 30 4))
sds's avatar
sds committed
68
               :test #'(lambda (x y) (and (realp x) (realp y) (< x y))))
69 70 71 72
  (1 2 10 x x 4))

(deftest subst.11
  (check-subst 'x 10 (copy-tree '(1 2 10 20 30 4))
sds's avatar
sds committed
73 74
               :test-not #'(lambda (x y)
                             (not (and (realp x) (realp y) (< x y)))))
75 76
  (1 2 10 x x 4))

77 78 79 80 81 82 83
(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))


84 85 86 87 88
;;; Order of argument evaluation
(deftest subst.order.1
  (let ((i 0) v w x y z)
    (values
     (subst (progn (setf v (incf i)) 'b)
sds's avatar
sds committed
89 90 91 92
            (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))
93 94 95 96 97 98 99 100
     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)
sds's avatar
sds committed
101 102 103 104 105
            (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)
            )
106 107 108 109
     i v w x y z))
  ((10 b . b) b b c ((b)) z)
  5 1 2 3 4 5)

pfdietz's avatar
pfdietz committed
110
;;; Const fold tests
111

pfdietz's avatar
pfdietz committed
112
(def-fold-test subst.fold.1 (subst 'a 'b '(a b c (a . b) . a)))
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133

;;; 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
sds's avatar
sds committed
134
         :bad t)
135 136 137 138 139 140 141
  (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
142 143
  (signals-error (subst) program-error)
  t)
144 145

(deftest subst.error.2
146 147
  (signals-error (subst 'a) program-error)
  t)
148 149

(deftest subst.error.3
150 151
  (signals-error (subst 'a 'b) program-error)
  t)
152 153

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

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

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

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

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

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

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