68 |
a b nil b a) |
a b nil b a) |
69 |
|
|
70 |
|
|
71 |
;;; Need to add more tests for ROTATEF here |
;;; ROTATEF is a good testbed for finding conflicts in setf expansions |
72 |
|
;;; These tests apply rotatef to various accessors |
73 |
|
|
74 |
|
(deftest rotatef.6 |
75 |
|
(let* ((x (list 'a 'b)) |
76 |
|
(y (list 'c 'd)) |
77 |
|
(z 'e)) |
78 |
|
(rotatef (car x) (car y) z) |
79 |
|
(values x y z)) |
80 |
|
(c b) (e d) a) |
81 |
|
|
82 |
|
(deftest rotatef.7 |
83 |
|
(let* ((x (list 'a 'b)) |
84 |
|
(y (list 'c 'd)) |
85 |
|
(z 'e)) |
86 |
|
(rotatef (first x) (first y) z) |
87 |
|
(values x y z)) |
88 |
|
(c b) (e d) a) |
89 |
|
|
90 |
|
(deftest rotatef.8 |
91 |
|
(let* ((x (list 'a 'b)) |
92 |
|
(y (list 'c 'd)) |
93 |
|
(z '(e))) |
94 |
|
(rotatef (cdr x) (cdr y) z) |
95 |
|
(values x y z)) |
96 |
|
(a d) (c e) (b)) |
97 |
|
|
98 |
|
(deftest rotatef.9 |
99 |
|
(let* ((x (list 'a 'b)) |
100 |
|
(y (list 'c 'd)) |
101 |
|
(z '(e))) |
102 |
|
(rotatef (rest x) (rest y) z) |
103 |
|
(values x y z)) |
104 |
|
(a d) (c e) (b)) |
105 |
|
|
106 |
|
(deftest rotatef.10 |
107 |
|
(let* ((x (list 'a 'b)) |
108 |
|
(y (list 'c 'd)) |
109 |
|
(z 'e)) |
110 |
|
(rotatef (cadr x) (cadr y) z) |
111 |
|
(values x y z)) |
112 |
|
(a d) (c e) b) |
113 |
|
|
114 |
|
(deftest rotatef.11 |
115 |
|
(let* ((x (list 'a 'b)) |
116 |
|
(y (list 'c 'd)) |
117 |
|
(z 'e)) |
118 |
|
(rotatef (second x) (second y) z) |
119 |
|
(values x y z)) |
120 |
|
(a d) (c e) b) |
121 |
|
|
122 |
|
(deftest rotatef.12 |
123 |
|
(let* ((x (list 'a 'b 'c)) |
124 |
|
(y (list 'd 'e 'f)) |
125 |
|
(z (list 'g))) |
126 |
|
(rotatef (cddr x) (cddr y) z) |
127 |
|
(values x y z)) |
128 |
|
(a b f) (d e g) (c)) |
129 |
|
|
130 |
|
(deftest rotatef.13 |
131 |
|
(let* ((x (list (list 'a))) |
132 |
|
(y (list (list 'c))) |
133 |
|
(z 'e)) |
134 |
|
(rotatef (caar x) (caar y) z) |
135 |
|
(values x y z)) |
136 |
|
((c)) ((e)) a) |
137 |
|
|
138 |
|
(deftest rotatef.14 |
139 |
|
(let* ((x (list (list 'a 'b))) |
140 |
|
(y (list (list 'c 'd))) |
141 |
|
(z (list 'e))) |
142 |
|
(rotatef (cdar x) (cdar y) z) |
143 |
|
(values x y z)) |
144 |
|
((a d)) ((c e)) (b)) |
145 |
|
|
146 |
|
;;; TODO: c*r accessors with > 2 a/d |
147 |
|
;;; TODO: third,...,tenth |
148 |
|
|
149 |
|
(deftest rotatef.15 |
150 |
|
(let* ((x (vector 'a 'b)) |
151 |
|
(y (vector 'c 'd)) |
152 |
|
(z 'e)) |
153 |
|
(rotatef (aref x 0) (aref y 0) z) |
154 |
|
(values x y z)) |
155 |
|
#(c b) #(e d) a) |
156 |
|
|
157 |
|
(deftest rotatef.16 |
158 |
|
(let* ((x (vector 'a 'b)) |
159 |
|
(y (vector 'c 'd)) |
160 |
|
(z 'e)) |
161 |
|
(rotatef (svref x 0) (svref y 0) z) |
162 |
|
(values x y z)) |
163 |
|
#(c b) #(e d) a) |
164 |
|
|
165 |
|
(deftest rotatef.17 |
166 |
|
(let* ((x (copy-seq #*11000)) |
167 |
|
(y (copy-seq #*11100)) |
168 |
|
(z 1)) |
169 |
|
(rotatef (bit x 1) (bit y 3) z) |
170 |
|
(values x y z)) |
171 |
|
#*10000 #*11110 1) |
172 |
|
|
173 |
|
(deftest rotatef.18 |
174 |
|
(let* ((x (copy-seq "abcde")) |
175 |
|
(y (copy-seq "fghij")) |
176 |
|
(z #\X)) |
177 |
|
(rotatef (char x 1) (char y 2) z) |
178 |
|
(values x y z)) |
179 |
|
"ahcde" "fgXij" #\b) |
180 |
|
|
181 |
|
(deftest rotatef.21 |
182 |
|
(let* ((x (copy-seq #*11000)) |
183 |
|
(y (copy-seq #*11100)) |
184 |
|
(z 1)) |
185 |
|
(rotatef (bit x 1) (bit y 3) z) |
186 |
|
(values x y z)) |
187 |
|
#*10000 #*11110 1) |
188 |
|
|
189 |
|
(deftest rotatef.22 |
190 |
|
(let* ((x (copy-seq "abcde")) |
191 |
|
(y (copy-seq "fghij")) |
192 |
|
(z #\X)) |
193 |
|
(rotatef (char x 1) (char y 2) z) |
194 |
|
(values x y z)) |
195 |
|
"ahcde" "fgXij" #\b) |
196 |
|
|
197 |
|
(deftest rotatef.23 |
198 |
|
(let* ((x (copy-seq '(a b c d e))) |
199 |
|
(y (copy-seq '(f g h i j))) |
200 |
|
(z 'k)) |
201 |
|
(rotatef (elt x 1) (elt y 2) z) |
202 |
|
(values x y z)) |
203 |
|
(a h c d e) (f g k i j) b) |
204 |
|
|
205 |
|
(deftest rotatef.24 |
206 |
|
(let ((x #b01010101) |
207 |
|
(y #b1111) |
208 |
|
(z 0)) |
209 |
|
(rotatef (ldb (byte 4 2) x) |
210 |
|
(ldb (byte 4 1) y) |
211 |
|
z) |
212 |
|
(values x y z)) |
213 |
|
#b01011101 |
214 |
|
1 |
215 |
|
#b0101) |
216 |
|
|
217 |
|
(deftest rotatef.25 |
218 |
|
(let* ((f1 (gensym)) |
219 |
|
(f2 (gensym)) |
220 |
|
(fn1 (constantly :foo)) |
221 |
|
(fn2 (constantly :bar)) |
222 |
|
(fn3 (constantly :zzz))) |
223 |
|
(setf (fdefinition f1) fn1 |
224 |
|
(fdefinition f2) fn2) |
225 |
|
(rotatef (fdefinition f1) |
226 |
|
(fdefinition f2) |
227 |
|
fn3) |
228 |
|
(values (funcall f1) (funcall f2) (funcall fn3))) |
229 |
|
:bar :zzz :foo) |
230 |
|
|
231 |
|
(deftest rotatef.26 |
232 |
|
(let* ((a1 (make-array '(10) :fill-pointer 5)) |
233 |
|
(a2 (make-array '(20) :fill-pointer 7)) |
234 |
|
(z 3)) |
235 |
|
(rotatef (fill-pointer a1) (fill-pointer a2) z) |
236 |
|
(values (fill-pointer a1) (fill-pointer a2) z)) |
237 |
|
7 3 5) |
238 |
|
|
239 |
|
(deftest rotatef.27 |
240 |
|
(let* ((x (list 'a 'b 'c 'd)) |
241 |
|
(y (list 'd 'e 'f 'g)) |
242 |
|
(n1 1) (n2 2) |
243 |
|
(z 'h)) |
244 |
|
(rotatef (nth n1 x) (nth n2 y) z) |
245 |
|
(values x y z)) |
246 |
|
(a f c d) |
247 |
|
(d e h g) |
248 |
|
b) |
249 |
|
|
250 |
|
(deftest rotatef.28 |
251 |
|
(let* ((f1 (gensym)) |
252 |
|
(f2 (gensym)) |
253 |
|
(fn1 (constantly :foo)) |
254 |
|
(fn2 (constantly :bar)) |
255 |
|
(fn3 (constantly :zzz))) |
256 |
|
(setf (symbol-function f1) fn1 |
257 |
|
(symbol-function f2) fn2) |
258 |
|
(rotatef (symbol-function f1) (symbol-function f2) fn3) |
259 |
|
(values (funcall f1) (funcall f2) (funcall fn3))) |
260 |
|
:bar :zzz :foo) |
261 |
|
|
262 |
|
(deftest rotatef.29 |
263 |
|
(let* ((s1 (gensym)) |
264 |
|
(s2 (gensym)) |
265 |
|
(z 1)) |
266 |
|
(setf (symbol-value s1) :foo |
267 |
|
(symbol-value s2) :bar) |
268 |
|
(rotatef (symbol-value s1) |
269 |
|
(symbol-value s2) |
270 |
|
z) |
271 |
|
(values (symbol-value s1) (symbol-value s2) z)) |
272 |
|
:bar 1 :foo) |
273 |
|
|
274 |
|
(deftest rotatef.30 |
275 |
|
(let* ((s1 (gensym)) |
276 |
|
(s2 (gensym)) |
277 |
|
(v1 (list :foo 1)) |
278 |
|
(v2 (list :bar 2)) |
279 |
|
(z nil)) |
280 |
|
(setf (symbol-plist s1) v1 |
281 |
|
(symbol-plist s2) v2) |
282 |
|
(rotatef (symbol-plist s1) (symbol-plist s2) z) |
283 |
|
(values (symbol-plist s1) (symbol-plist s2) z)) |
284 |
|
(:bar 2) nil (:foo 1)) |
285 |
|
|
286 |
|
(deftest rotatef.31 |
287 |
|
(let* ((x (list 'a 'b 'c 'd 'e)) |
288 |
|
(y (list 'f 'g 'h 'i 'j)) |
289 |
|
(p1 1) (p2 2) (len 3) |
290 |
|
(z '(10 11 12))) |
291 |
|
(rotatef (subseq x p1 (+ p1 len)) |
292 |
|
(subseq y p2 (+ p2 len)) |
293 |
|
z) |
294 |
|
(values x y z)) |
295 |
|
(a h i j e) |
296 |
|
(f g 10 11 12) |
297 |
|
(b c d)) |
298 |
|
|
299 |
|
(deftest rotatef.32 |
300 |
|
(let* ((x (gensym)) |
301 |
|
(y (gensym)) |
302 |
|
(k1 :foo) |
303 |
|
(k2 :bar) |
304 |
|
(v1 1) |
305 |
|
(v2 2) |
306 |
|
(z 17)) |
307 |
|
(setf (get x k1) v1 (get y k2) v2) |
308 |
|
(rotatef (get x k1) (get y k2) z) |
309 |
|
(values (symbol-plist x) (symbol-plist y) z)) |
310 |
|
(:foo 2) (:bar 17) 1) |
311 |
|
|
312 |
|
(deftest rotatef.33 |
313 |
|
(let* ((x nil) |
314 |
|
(y nil) |
315 |
|
(k1 :foo) |
316 |
|
(k2 :bar) |
317 |
|
(v1 1) |
318 |
|
(v2 2) |
319 |
|
(z 21)) |
320 |
|
(setf (getf x k1) v1 (getf y k2) v2) |
321 |
|
(rotatef (getf x k1) (getf y k2) z) |
322 |
|
(values x y z)) |
323 |
|
(:foo 2) (:bar 21) 1) |
324 |
|
|
325 |
|
(deftest rotatef.34 |
326 |
|
(let* ((ht1 (make-hash-table)) |
327 |
|
(ht2 (make-hash-table)) |
328 |
|
(k1 :foo) (v1 1) |
329 |
|
(k2 :bar) (v2 2) |
330 |
|
(z 3)) |
331 |
|
(setf (gethash k1 ht1) v1 |
332 |
|
(gethash k2 ht2) v2) |
333 |
|
(rotatef z (gethash k1 ht1) (gethash k2 ht2)) |
334 |
|
(values z (gethash k1 ht1) (gethash k2 ht2))) |
335 |
|
1 2 3) |
336 |
|
|
337 |
|
(deftest rotatef.35 |
338 |
|
(let ((n1 (gensym)) |
339 |
|
(n2 (gensym)) |
340 |
|
(n3 (gensym)) |
341 |
|
(n4 (gensym))) |
342 |
|
(eval `(defclass ,n1 () ())) |
343 |
|
(eval `(defclass ,n2 () ())) |
344 |
|
(setf (find-class n3) (find-class n1) |
345 |
|
(find-class n4) (find-class n2)) |
346 |
|
(rotatef (find-class n3) (find-class n4)) |
347 |
|
(values (eqlt (find-class n1) (find-class n4)) |
348 |
|
(eqlt (find-class n2) (find-class n3)))) |
349 |
|
t t) |
350 |
|
|
351 |
|
;;; TODO: macro-function, mask-field, row-major-aref, |
352 |
|
;;; logical-pathname-translations, readtable-case |