source: trunk/source/tests/ansi-tests/macrolet.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: 9.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Oct  9 19:41:24 2002
4;;;; Contains: Tests of MACROLET
5
6(in-package :cl-test)
7
8(deftest macrolet.1
9  (let ((z (list 3 4)))
10    (macrolet ((%m (x) `(car ,x)))
11      (let ((y (list 1 2)))
12        (values (%m y) (%m z)))))
13  1 3)
14
15(deftest macrolet.2
16  (let ((z (list 3 4)))
17    (macrolet ((%m (x) `(car ,x)))
18      (let ((y (list 1 2)))
19        (values
20         (setf (%m y) 6)
21         (setf (%m z) 'a)
22         y z))))
23  6 a (6 2) (a 4))
24
25;;; Inner definitions shadow outer ones
26(deftest macrolet.3
27  (macrolet ((%m (w) `(cadr ,w)))
28    (let ((z (list 3 4)))
29      (macrolet ((%m (x) `(car ,x)))
30        (let ((y (list 1 2)))
31          (values
32           (%m y) (%m z)
33           (setf (%m y) 6)
34           (setf (%m z) 'a)
35           y z)))))
36  1 3 6 a (6 2) (a 4))
37
38;;; &whole parameter
39(deftest macrolet.4
40  (let ((x nil))
41    (macrolet ((%m (&whole w arg)
42                   `(progn (setq x (quote ,w))
43                           ,arg)))
44      (values (%m 1) x)))
45  1 (%m 1))
46
47;;; &whole parameter (nested, destructuring; see section 3.4.4)
48(deftest macrolet.5
49  (let ((x nil))
50    (macrolet ((%m ((&whole w arg))
51                   `(progn (setq x (quote ,w))
52                           ,arg)))
53      (values (%m (1)) x)))
54  1 (1))
55
56;;; key parameter
57(deftest macrolet.6
58  (let ((x nil))
59    (macrolet ((%m (&key (a 'xxx) b)
60                   `(setq x (quote ,a))))
61                           
62      (values (%m :a foo) x
63              (%m :b bar) x)))
64  foo foo xxx xxx)
65
66;;; nested key parameters
67(deftest macrolet.7
68  (let ((x nil))
69    (macrolet ((%m ((&key a b))
70                   `(setq x (quote ,a))))
71                           
72      (values (%m (:a foo)) x
73              (%m (:b bar)) x)))
74  foo foo nil nil)
75
76;;; nested key parameters
77(deftest macrolet.8
78  (let ((x nil))
79    (macrolet ((%m ((&key (a 10) b))
80                   `(setq x (quote ,a))))
81                           
82      (values (%m (:a foo)) x
83              (%m (:b bar)) x)))
84  foo foo 10 10)
85
86;;; keyword parameter with supplied-p parameter
87(deftest macrolet.9
88  (let ((x nil))
89    (macrolet ((%m (&key (a 'xxx a-p) b)
90                   `(setq x (quote ,(list a (not (not a-p)))))))
91                           
92      (values (%m :a foo) x
93              (%m :b bar) x)))
94  (foo t) (foo t) (xxx nil) (xxx nil))
95
96
97;;; rest parameter
98(deftest macrolet.10
99  (let ((x nil))
100    (macrolet ((%m (b &rest a)
101                   `(setq x (quote ,a))))
102      (values (%m a1 a2) x)))
103  (a2) (a2))
104
105;;; rest parameter w. destructuring
106(deftest macrolet.11
107  (let ((x nil))
108    (macrolet ((%m ((b &rest a))
109                   `(setq x (quote ,a))))
110      (values (%m (a1 a2)) x)))
111  (a2) (a2))
112
113;;; rest parameter w. whole
114(deftest macrolet.12
115  (let ((x nil))
116    (macrolet ((%m (&whole w b &rest a)
117                   `(setq x (quote ,(list a w)))))
118      (values (%m a1 a2) x)))
119  ((a2) (%m a1 a2))
120  ((a2) (%m a1 a2)))
121
122;;; Interaction with symbol-macrolet
123
124(deftest macrolet.13
125  (symbol-macrolet ((a b))
126    (macrolet ((foo (x &environment env)
127                    (let ((y (macroexpand x env)))
128                      (if (eq y 'a) 1 2))))
129      (foo a)))
130  2)
131
132(deftest macrolet.14
133  (symbol-macrolet ((a b))
134    (macrolet ((foo (x &environment env)
135                    (let ((y (macroexpand-1 x env)))
136                      (if (eq y 'a) 1 2))))
137      (foo a)))
138  2)
139
140(deftest macrolet.15
141  (macrolet ((nil () ''a))
142    (nil))
143  a)
144
145(deftest macrolet.16
146  (loop for s in *cl-non-function-macro-special-operator-symbols*
147        for form = `(ignore-errors (macrolet ((,s () ''a)) (,s)))
148        unless (eq (eval form) 'a)
149        collect s)
150  nil)
151
152(deftest macrolet.17
153  (macrolet ((%m (&key (a t)) `(quote ,a)))
154    (%m :a nil))
155  nil)
156
157(deftest macrolet.18
158  (macrolet ((%m (&key (a t a-p)) `(quote (,a ,(notnot a-p)))))
159    (%m :a nil))
160  (nil t))
161
162(deftest macrolet.19
163  (macrolet ((%m (x &optional y) `(quote (,x ,y))))
164    (values (%m 1) (%m 2 3)))
165  (1 nil)
166  (2 3))
167
168(deftest macrolet.20
169  (macrolet ((%m (x &optional (y 'a)) `(quote (,x ,y))))
170    (values (%m 1) (%m 2 3)))
171  (1 a)
172  (2 3))
173
174;;; Note -- the supplied-p parameter in a macrolet &optional
175;;; is required to be T (not just true) if the parameter is present.
176;;; See section 3.4.4.1.2
177(deftest macrolet.21
178  (macrolet ((%m (x &optional (y 'a y-p)) `(quote (,x ,y ,y-p))))
179    (values (%m 1) (%m 2 3)))
180  (1 a nil)
181  (2 3 t))
182
183(deftest macrolet.22
184  (macrolet ((%m (x &optional ((y z) '(2 3))) `(quote (,x ,y ,z))))
185    (values
186     (%m a)
187     (%m a (b c))))
188  (a 2 3)
189  (a b c))
190
191(deftest macrolet.22a
192  (macrolet ((%m (x &optional ((y z) '(2 3) y-z-p))
193                 `(quote (,x ,y ,z ,y-z-p))))
194    (values
195     (%m a)
196     (%m a (b c))))
197  (a 2 3 nil)
198  (a b c t))
199
200(deftest macrolet.23
201  (macrolet ((%m (&rest y) `(quote ,y)))
202    (%m 1 2 3))
203  (1 2 3))
204
205;;; According to 3.4.4.1.2, the entity following &rest is
206;;; 'a destructuring pattern that matches the rest of the list.'
207
208(deftest macrolet.24
209  (macrolet ((%m (&rest (x y z)) `(quote (,x ,y ,z))))
210    (%m 1 2 3))
211  (1 2 3))
212
213(deftest macrolet.25
214  (macrolet ((%m (&body (x y z)) `(quote (,x ,y ,z))))
215    (%m 1 2 3))
216  (1 2 3))
217
218;;; More key parameters
219
220(deftest macrolet.26
221  (macrolet ((%m (&key ((:a b))) `(quote ,b)))
222    (values (%m)
223            (%m :a x)))
224  nil
225  x)
226
227(deftest macrolet.27
228  (macrolet ((%m (&key ((:a (b c)))) `(quote (,c ,b))))
229    (%m :a (1 2)))
230  (2 1))
231
232(deftest macrolet.28
233  (macrolet ((%m (&key ((:a (b c)) '(3 4))) `(quote (,c ,b))))
234    (values (%m :a (1 2))
235            (%m :a (1 2) :a (10 11))
236            (%m)))
237  (2 1)
238  (2 1)
239  (4 3))
240
241(deftest macrolet.29
242  (macrolet ((%m (&key a (b a)) `(quote (,a ,b))))
243    (values (%m)
244            (%m :a 1)
245            (%m :b 2)
246            (%m :a 3 :b 4)
247            (%m :b 5 :a 6)
248            (%m :a 7 :a 8)
249            (%m :a 9 :b nil)
250            (%m :a 10 :b nil :b 11)))
251  (nil nil)
252  (1 1)
253  (nil 2)
254  (3 4)
255  (6 5)
256  (7 7)
257  (9 nil)
258  (10 nil))
259
260(deftest macrolet.30
261  (macrolet ((%m ((&key a) &key (b a)) `(quote (,a ,b))))
262    (values (%m ())
263            (%m (:a 1))
264            (%m () :b 2)
265            (%m (:a 3) :b 4)
266            (%m (:a 7 :a 8))
267            (%m (:a 9) :b nil)
268            (%m (:a 10) :b nil :b 11)))
269  (nil nil)
270  (1 1)
271  (nil 2)
272  (3 4)
273  (7 7)
274  (9 nil)
275  (10 nil))
276
277(deftest macrolet.31
278  (macrolet ((%m (&key ((:a (b c)) '(3 4) a-p))
279                 `(quote (,(notnot a-p) ,c ,b))))
280    (values (%m :a (1 2))
281            (%m :a (1 2) :a (10 11))
282            (%m)))
283  (t 2 1)
284  (t 2 1)
285  (nil 4 3))
286
287;;; Allow-other-keys tests
288
289(deftest macrolet.32
290  (macrolet ((%m (&key a b c) `(quote (,a ,b ,c))))
291    (values
292     (%m :allow-other-keys nil)
293     (%m :a 1 :allow-other-keys nil)
294     (%m :allow-other-keys t)
295     (%m :allow-other-keys t :allow-other-keys nil :foo t)
296     (%m :allow-other-keys t :c 1 :b 2 :a 3)
297     (%m :allow-other-keys nil :c 1 :b 2 :a 3)))
298  (nil nil nil)
299  (1 nil nil)
300  (nil nil nil)
301  (nil nil nil)
302  (3 2 1)
303  (3 2 1))
304
305(deftest macrolet.33
306  (macrolet ((%m (&key allow-other-keys) `(quote ,allow-other-keys)))
307    (values
308     (%m)
309     (%m :allow-other-keys nil)
310     (%m :allow-other-keys t :foo t)))
311  nil
312  nil
313  t)
314
315(deftest macrolet.34
316  (macrolet ((%m (&key &allow-other-keys) :good))
317    (values
318     (%m)
319     (%m :foo t)
320     (%m :allow-other-keys nil :foo t)))
321  :good
322  :good
323  :good)
324
325(deftest macrolet.35
326  (macrolet ((%m (&key a b &allow-other-keys) `(quote (,a ,b))))
327    (values
328     (%m :a 1)
329     (%m :foo t :b 2)
330     (%m :allow-other-keys nil :a 1 :foo t :b 2)))
331  (1 nil)
332  (nil 2)
333  (1 2))
334
335;;; &whole is followed by a destructuring pattern (see 3.4.4.1.2)
336(deftest macrolet.36
337  (macrolet ((%m (&whole (m a b) c d) `(quote (,m ,a ,b ,c ,d))))
338    (%m 1 2))
339  (%m 1 2 1 2))
340
341;;; Macro names are shadowed by local functions
342
343(deftest macrolet.37
344  (macrolet ((%f () :bad))
345    (flet ((%f () :good))
346      (%f)))
347  :good)
348
349;;; The &environment parameter is bound first
350
351(deftest macrolet.38
352  (macrolet ((foo () 1))
353    (macrolet ((%f (&optional (x (macroexpand '(foo) env)) &environment env)
354                   x))
355      (%f)))
356  1)
357
358;;; Test for bug that showed up in sbcl
359
360(deftest macrolet.39
361  (macrolet ((%m (()) :good)) (%m ()))
362  :good)
363
364;;; Test that macrolets accept declarations
365
366(deftest macrolet.40
367  (macrolet ((%x () t))
368    (declare (optimize)))
369  nil)
370
371(deftest macrolet.41
372  (macrolet ((%x () t))
373    (declare (optimize))
374    (declare (notinline identity)))
375  nil)
376
377(deftest macrolet.42
378  (macrolet ((%x () t))
379    (declare (optimize))
380    (%x))
381  t)
382
383(deftest macrolet.43
384  (let ((*x-in-macrolet.43* nil))
385    (declare (special *x-in-macrolet.43*))
386    (let ((*f* #'(lambda () *x-in-macrolet.43*)))
387      (declare (special *f*))
388      (eval `(macrolet ((%m (*x-in-macrolet.43*)
389                            (declare (special *f*))
390                            (funcall *f*)))
391               (%m t)))))
392  nil)
393
394(deftest macrolet.44
395  (let ((*x-in-macrolet.44* nil))
396    (declare (special *x-in-macrolet.44*))
397    (let ((*f* #'(lambda () *x-in-macrolet.44*)))
398      (declare (special *f*))
399      (eval `(macrolet ((%m (*x-in-macrolet.44*)
400                            (declare (special *f* *x-in-macrolet.44*))
401                            (funcall *f*)))
402               (%m t)))))
403  t)
404
405(deftest macrolet.45
406  (let ((*x-in-macrolet.45* nil))
407    (declare (special *x-in-macrolet.45*))
408    (let ((*f* #'(lambda () *x-in-macrolet.45*)))
409      (declare (special *f*))
410      (eval `(macrolet ((%m ((*x-in-macrolet.45*))
411                            (declare (special *f* *x-in-macrolet.45*))
412                            (funcall *f*)))
413               (%m (t))))))
414  t)
415
416;;; Macros are expanded in the appropriate environment
417
418(deftest macrolet.46
419  (macrolet ((%m (z) z))
420            (macrolet () (expand-in-current-env (%m :good))))
421  :good)
422
423;;; Free declarations in macrolet
424
425(deftest macrolet.47
426  (let ((x :good))
427    (declare (special x))
428    (let ((x :bad))
429      (macrolet () (declare (special x)) x)))
430  :good)
431
432(deftest macrolet.48
433  (let ((x :good))
434    (let ((y :bad))
435      (macrolet () (declare (ignore y)) x)))
436  :good)
437
438(deftest macrolet.49
439  (let ((x :good))
440    (let ((y :bad))
441      (macrolet () (declare (ignorable y)) x)))
442  :good)
443
444
445;;; TODO: more special declarations for other macrolet arguments
Note: See TracBrowser for help on using the repository browser.