/[ansi-test]/trunk/ansi-tests/macrolet.lsp
ViewVC logotype

Contents of /trunk/ansi-tests/macrolet.lsp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2166 - (show annotations)
Sun Sep 25 21:02:28 2011 UTC (2 years, 6 months ago) by ehuelsmann
File size: 10742 byte(s)
Test that local function and macro definitions shadow global macro,
function and compiler-macro definitions.
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
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 (funcall *f*)))
392 (%m t)))))
393 nil)
394
395 (deftest macrolet.44
396 (let ((*x-in-macrolet.44* nil))
397 (declare (special *x-in-macrolet.44*))
398 (let ((*f* #'(lambda () *x-in-macrolet.44*)))
399 (declare (special *f*))
400 (eval `(macrolet ((%m (*x-in-macrolet.44*)
401 (declare (special *f* *x-in-macrolet.44*))
402 (funcall *f*)))
403 (%m t)))))
404 t)
405
406 (deftest macrolet.45
407 (let ((*x-in-macrolet.45* nil))
408 (declare (special *x-in-macrolet.45*))
409 (let ((*f* #'(lambda () *x-in-macrolet.45*)))
410 (declare (special *f*))
411 (eval `(macrolet ((%m ((*x-in-macrolet.45*))
412 (declare (special *f* *x-in-macrolet.45*))
413 (funcall *f*)))
414 (%m (t))))))
415 t)
416
417 ;;; Macros are expanded in the appropriate environment
418
419 (deftest macrolet.46
420 (macrolet ((%m (z) z))
421 (macrolet () (expand-in-current-env (%m :good))))
422 :good)
423
424 ;;; Free declarations in macrolet
425
426 (deftest macrolet.47
427 (let ((x :good))
428 (declare (special x))
429 (let ((x :bad))
430 (macrolet () (declare (special x)) x)))
431 :good)
432
433 (deftest macrolet.48
434 (let ((x :good))
435 (let ((y :bad))
436 (macrolet () (declare (ignore y)) x)))
437 :good)
438
439 (deftest macrolet.49
440 (let ((x :good))
441 (let ((y :bad))
442 (macrolet () (declare (ignorable y)) x)))
443 :good)
444
445
446 ;;; TODO: more special declarations for other macrolet arguments
447
448
449 ;;; macrolet shadows global macro, function and compiler-macro
450 ;;; definitions
451
452 (defmacro macrolet.50 () :bad)
453
454 (deftest macrolet.50
455 (macrolet ((macrolet.50 () :good))
456 (macrolet.50))
457 :good)
458
459 (defun macrolet.51 () :bad)
460
461 (deftest macrolet.51
462 (macrolet ((macrolet.51 () :good))
463 (macrolet.51))
464 :good)
465
466 (define-compiler-macro macrolet.52 (&whole form)
467 :bad)
468
469 (deftest macrolet.52
470 (macrolet ((macrolet.52 () :good))
471 (macrolet.52))
472 :good)

Properties

Name Value
svn:eol-style native
svn:keywords Author Date Id Revision

  ViewVC Help
Powered by ViewVC 1.1.5