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

(in-package :cl-test)

8
9
(compile-and-load "cons-aux.lsp")

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)