source: trunk/source/tests/ansi-tests/rotatef.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 7.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 15:44:38 2003
4;;;; Contains: Tests for ROTATEF
5
6(in-package :cl-test)
7
8(deftest rotatef-order.1
9  (let ((x (vector 'a 'b 'c 'd 'e 'f))
10        (i 2))
11    (values
12     (rotatef (aref x (incf i)) (aref x (incf i)))
13     x i))
14  nil
15  #(a b c e d f)
16  4)
17
18(deftest rotatef-order.2
19  (let ((x (vector 'a 'b 'c 'd 'e 'f))
20        (i 2))
21    (values
22     (rotatef (aref x (incf i)) (aref x (incf i)) (aref x (incf i)))
23     x i))
24  nil
25  #(a b c e f d)
26  5)
27
28(deftest rotatef.1
29  (let ((x (vector 0 1 2)))
30    (values
31     (rotatef (aref x (aref x 0)) (aref x (aref x 1)) (aref x (aref x 2)))
32     x))
33  nil
34  #(1 2 0))
35
36(deftest rotatef.2
37  (let ((x (vector 0 1 2 3 4 5 6 7 8 9)))
38    (values
39     (rotatef (aref x (aref x 0))
40              (aref x (aref x 1))
41              (aref x (aref x 2))
42              (aref x (aref x 3))
43              (aref x (aref x 4))
44              (aref x (aref x 5))
45              (aref x (aref x 6))
46              (aref x (aref x 7))
47              (aref x (aref x 8))
48              (aref x (aref x 9)))
49     x))
50  nil
51  #(1 2 3 4 5 6 7 8 9 0))
52
53(deftest rotatef.3
54  (rotatef)
55  nil)
56
57(deftest rotatef.4
58  (let ((x 10))
59    (values
60     x
61     (rotatef x)
62     x))
63  10 nil 10)
64
65(deftest rotatef.5
66  (let ((x 'a) (y 'b))
67    (values x y (rotatef x y) x y))
68  a b nil b a)
69 
70
71;;; 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;;; Test that explicit calls to macroexpand in subforms
352;;; are done in the correct environment
353
354(deftest rotatef.36
355  (macrolet
356   ((%m (z) z))
357   (let ((x 1) (y 2))
358     (rotatef (expand-in-current-env (%m x)) y)
359     (values x y)))
360  2 1)
361
362(deftest rotatef.37
363  (macrolet
364   ((%m (z) z))
365   (let ((x 1) (y 2))
366     (rotatef x (expand-in-current-env (%m y)))
367     (values x y)))
368  2 1)
369
370;;; TODO: macro-function, mask-field, row-major-aref,
371;;;   logical-pathname-translations, readtable-case
Note: See TracBrowser for help on using the repository browser.