/[gcl]/gcl/ansi-tests/rotatef.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/rotatef.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by pfdietz, Fri Oct 24 08:59:51 2003 UTC revision 1.3 by pfdietz, Sun Jun 26 02:48:25 2005 UTC
# Line 68  Line 68 
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

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26