← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/macrolet.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

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