source: trunk/tests/ansi-tests/macrolet.lsp @ 14368

Last change on this file since 14368 was 14368, checked in by gz, 9 years ago

Don't muffle warnings when running test, as that affects the return values from compile-file. Tweak tests to not cause warnings

File size: 9.5 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#+known-bug-269
337(deftest macrolet.36
338  (macrolet ((%m (&whole (m a b) c d) `(quote (,m ,a ,b ,c ,d))))
339    (%m 1 2))
340  (%m 1 2 1 2))
341
342;;; Macro names are shadowed by local functions
343
344(deftest macrolet.37
345  (macrolet ((%f () :bad))
346    (flet ((%f () :good))
347      (%f)))
348  :good)
349
350;;; The &environment parameter is bound first
351
352(deftest macrolet.38
353  (macrolet ((foo () 1))
354    (macrolet ((%f (&optional (x (macroexpand '(foo) env)) &environment env)
355                   x))
356      (%f)))
357  1)
358
359;;; Test for bug that showed up in sbcl
360
361(deftest macrolet.39
362  (macrolet ((%m (()) :good)) (%m ()))
363  :good)
364
365;;; Test that macrolets accept declarations
366
367(deftest macrolet.40
368  (macrolet ((%x () t))
369    (declare (optimize)))
370  nil)
371
372(deftest macrolet.41
373  (macrolet ((%x () t))
374    (declare (optimize))
375    (declare (notinline identity)))
376  nil)
377
378(deftest macrolet.42
379  (macrolet ((%x () t))
380    (declare (optimize))
381    (%x))
382  t)
383
384(deftest macrolet.43
385  (let ((*x-in-macrolet.43* nil))
386    (declare (special *x-in-macrolet.43*))
387    (let ((*f* #'(lambda () *x-in-macrolet.43*)))
388      (declare (special *f*))
389      (eval `(macrolet ((%m (*x-in-macrolet.43*)
390                            (declare (special *f*))
391                            *x-in-macrolet.43*
392                            (funcall *f*)))
393               (%m t)))))
394  nil)
395
396(deftest macrolet.44
397  (let ((*x-in-macrolet.44* nil))
398    (declare (special *x-in-macrolet.44*))
399    (let ((*f* #'(lambda () *x-in-macrolet.44*)))
400      (declare (special *f*))
401      (eval `(macrolet ((%m (*x-in-macrolet.44*)
402                            (declare (special *f* *x-in-macrolet.44*))
403                            (funcall *f*)))
404               (%m t)))))
405  t)
406
407(deftest macrolet.45
408  (let ((*x-in-macrolet.45* nil))
409    (declare (special *x-in-macrolet.45*))
410    (let ((*f* #'(lambda () *x-in-macrolet.45*)))
411      (declare (special *f*))
412      (eval `(macrolet ((%m ((*x-in-macrolet.45*))
413                            (declare (special *f* *x-in-macrolet.45*))
414                            (funcall *f*)))
415               (%m (t))))))
416  t)
417
418;;; Macros are expanded in the appropriate environment
419
420(deftest macrolet.46
421  (macrolet ((%m (z) z))
422            (macrolet () (expand-in-current-env (%m :good))))
423  :good)
424
425;;; Free declarations in macrolet
426
427#+bogus-test
428(deftest macrolet.47
429  (let ((x :good))
430    (declare (special x))
431    (let ((x :bad))
432      (macrolet () (declare (special x)) x)))
433  :good)
434
435(deftest macrolet.48
436  (let ((x :good))
437    (let ((y :bad))
438      (macrolet () (declare (ignore y)) x)))
439  :good)
440
441(deftest macrolet.49
442  (let ((x :good))
443    (let ((y :bad))
444      (macrolet () (declare (ignorable y)) x)))
445  :good)
446
447
448;;; TODO: more special declarations for other macrolet arguments
Note: See TracBrowser for help on using the repository browser.