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

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

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

File size: 8.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 12:35:24 2003
4;;;; Contains: Tests of DEFMACRO
5
6(in-package :cl-test)
7
8(deftest defmacro.error.1
9  (signals-error (funcall (macro-function 'defmacro))
10                 program-error)
11  t)
12
13(deftest defmacro.error.2
14  (signals-error (funcall (macro-function 'defmacro)
15                           '(defmacro nonexistent-macro ()))
16                 program-error)
17  t)
18
19(deftest defmacro.error.3
20  (signals-error (funcall (macro-function 'defmacro)
21                           '(defmacro nonexistent-macro ())
22                           nil nil)
23                 program-error)
24  t)
25
26;;; FIXME
27;;; Need to add non-error tests
28
29(deftest defmacro.1
30  (progn
31    (assert (eq (defmacro defmacro.1-macro (x y) `(list 1 ,x 2 ,y 3))
32                'defmacro.1-macro))
33    (assert (macro-function 'defmacro.1-macro))
34    (eval `(defmacro.1-macro 'a 'b)))
35  (1 a 2 b 3))
36
37(deftest defmacro.2
38  (progn
39    (assert (eq (defmacro defmacro.2-macro (x y)
40                  (return-from defmacro.2-macro `(cons ,x ,y)))
41                'defmacro.2-macro))
42    (assert (macro-function 'defmacro.2-macro))
43    (eval `(defmacro.2-macro 'a 'b)))
44  (a . b))
45
46;;; The macro function is defined in the lexical environment in which
47;;; the defmacro form occurs.
48(deftest defmacro.3
49  (let (fn)
50    (let ((x 0))
51      (setq fn #'(lambda (n) (setq x n)))
52      (defmacro defmacro.3-macro () `',x))
53    (values
54     (eval '(defmacro.3-macro))
55     (funcall fn 'a)
56     (eval '(defmacro.3-macro))))
57  0 a a)
58
59;;; Declarations are allowed.
60
61;;; Free special declarations do not apply to the forms
62;;; in the lambda list
63(deftest defmacro.4
64  (let ((y :good))
65    (assert (eq (defmacro defmacro.4-macro (&optional (x y))
66                  (declare (special y))
67                  x)
68                'defmacro.4-macro))
69    (let ((y :bad))
70      (declare (special y))
71      (values (macroexpand-1 '(defmacro.4-macro)))))
72  :good)
73
74(deftest defmacro.5
75  (progn
76    (assert (eq (defmacro defmacro.5-macro ()
77                  (declare) (declare) "a doc string" (declare)
78                  t)
79                'defmacro.5-macro))
80    (eval `(defmacro.5-macro)))
81  t)
82
83;;; &whole argument, top level
84(deftest defmacro.6
85  (progn
86    (defmacro defmacro.6-macro (&whole w arg)
87      `(list ',w ',arg))
88    (eval `(defmacro.6-macro x)))
89  ((defmacro.6-macro x) x))
90
91;;; &whole argument in destructuring
92(deftest defmacro.7
93  (progn
94    (defmacro defmacro.7-macro (arg1 (&whole w arg2))
95      `(list ',w ',arg1 ',arg2))
96    (eval `(defmacro.7-macro x (y))))
97  ((y) x y))
98
99;;; keyword parameters
100(deftest defmacro.8
101  (progn
102    (defmacro defmacro.8-macro (&key foo bar)
103      `(list ',foo ',bar))
104    (mapcar #'eval '((defmacro.8-macro :foo x)
105                     (defmacro.8-macro :bar y)
106                     (defmacro.8-macro :bar a :foo b)
107                     (defmacro.8-macro :bar a :foo b :bar c))))
108  ((x nil) (nil y) (b a) (b a)))
109
110;;; keyword parameters with default value
111(deftest defmacro.9
112  (progn
113    (defmacro defmacro.9-macro (&key (foo 1) (bar 2))
114      `(list ',foo ',bar))
115    (mapcar #'eval '((defmacro.9-macro :foo x)
116                     (defmacro.9-macro :bar y)
117                     (defmacro.9-macro :foo nil)
118                     (defmacro.9-macro :bar nil)
119                     (defmacro.9-macro :bar a :foo b)
120                     (defmacro.9-macro :bar a :foo b :bar c))))
121  ((x 2) (1 y) (nil 2) (1 nil) (b a) (b a)))
122
123;;; keyword parameters with supplied-p parameter
124(deftest defmacro.10
125  (progn
126    (defmacro defmacro.10-macro (&key (foo 1 foo-p) (bar 2 bar-p))
127      `(list ',foo ,(notnot foo-p) ',bar ,(notnot bar-p)))
128    (mapcar #'eval '((defmacro.10-macro)
129                     (defmacro.10-macro :foo x)
130                     (defmacro.10-macro :bar y)
131                     (defmacro.10-macro :foo nil)
132                     (defmacro.10-macro :bar nil)
133                     (defmacro.10-macro :foo x :bar y)
134                     (defmacro.10-macro :bar y :foo x)
135                     (defmacro.10-macro :bar a :bar b)
136                     (defmacro.10-macro :foo a :foo b))))
137  ((1 nil 2 nil) (x t 2 nil) (1 nil y t)
138   (nil t 2 nil) (1 nil nil t) (x t y t)
139   (x t y t) (1 nil a t) (a t 2 nil)))
140
141;;; key arguments in destructuring
142
143(deftest defmacro.11
144  (progn
145    (defmacro defmacro.11-macro ((&key foo bar)) `(list ',foo ',bar))
146    (mapcar #'eval '((defmacro.11-macro nil)
147                     (defmacro.11-macro (:foo x))
148                     (defmacro.11-macro (:bar y))
149                     (defmacro.11-macro (:foo x :bar y :foo z))
150                     (defmacro.11-macro (:bar y :bar z :foo x)))))
151  ((nil nil) (x nil) (nil y) (x y) (x y)))
152
153;;;  key arguments in destructuring and defaults
154
155(deftest defmacro.12
156  (progn
157    (let ((foo-default 1)
158          (bar-default 2))
159      (defmacro defmacro.12-macro ((&key (foo foo-default)
160                                         (bar bar-default)))
161        `(list ',foo ',bar)))
162    (mapcar #'eval '((defmacro.12-macro nil)
163                     (defmacro.12-macro (:foo x))
164                     (defmacro.12-macro (:bar y))
165                     (defmacro.12-macro (:foo x :bar y :foo z))
166                     (defmacro.12-macro (:bar y :bar z :foo x)))))
167  ((1 2) (x 2) (1 y) (x y) (x y)))
168
169;;;  key arguments in destructuring and supplied-p parameter
170
171(deftest defmacro.13
172  (progn
173    (let ((foo-default 1)
174          (bar-default 2))
175      (defmacro defmacro.13-macro ((&key (foo foo-default foo-p)
176                                         (bar bar-default bar-p)))
177        `(list ',foo ,(notnot foo-p) ',bar ,(notnot bar-p))))
178    (mapcar #'eval '((defmacro.13-macro nil)
179                     (defmacro.13-macro (:foo x))
180                     (defmacro.13-macro (:bar y))
181                     (defmacro.13-macro (:foo nil :bar nil :foo 4 :bar 14))
182                     (defmacro.13-macro (:foo 1 :bar 2))
183                     (defmacro.13-macro (:foo x :bar y :foo z))
184                     (defmacro.13-macro (:bar y :bar z :foo x)))))
185  ((1 nil 2 nil) (x t 2 nil) (1 nil y t)
186   (nil t nil t) (1 t 2 t)
187   (x t y t) (x t y t)))
188
189;;; rest parameter
190(deftest defmacro.14
191  (progn
192    (defmacro defmacro.14-macro (foo &rest bar)
193      `(list ',foo ',bar))
194    (mapcar #'eval '((defmacro.14-macro x)
195                     (defmacro.14-macro x y)
196                     (defmacro.14-macro x y z))))
197  ((x nil) (x (y)) (x (y z))))
198
199;;; rest parameter with destructuring
200(deftest defmacro.15
201  (progn
202    (defmacro defmacro.15-macro (foo &rest (bar . baz))
203      `(list ',foo ',bar ',baz))
204    (eval '(defmacro.15-macro x y z)))
205  (x y (z)))
206
207;;; rest parameter w. whole
208(deftest defmacro.16
209  (progn
210    (defmacro defmacro.16-macro (&whole w foo &rest bar)
211      `(list ',w ',foo ',bar))
212    (mapcar #'eval '((defmacro.16-macro x)
213                     (defmacro.16-macro x y)
214                     (defmacro.16-macro x y z))))
215  (((defmacro.16-macro x) x nil)
216   ((defmacro.16-macro x y) x (y))
217   ((defmacro.16-macro x y z) x (y z))))
218
219;;; env parameter
220(deftest defmacro.17
221  (progn
222    (defmacro defmacro.17-macro (x &environment env)
223      `(quote ,(macroexpand x env)))
224    (eval
225     `(macrolet ((%m () :good))
226        (defmacro.17-macro (%m)))))
227  :good)
228
229(deftest defmacro.17a
230  (progn
231    (defmacro defmacro.17a-macro (&environment env x)
232      `(quote ,(macroexpand x env)))
233    (eval
234     `(macrolet ((%m () :good))
235        (defmacro.17a-macro (%m)))))
236  :good)
237
238;;; &optional with supplied-p parameter
239;;; Note: this is required to be T if the parameter is present (3.4.4.1.2)
240(deftest defmacro.18
241  (progn
242    (defmacro defmacro.18-macro (x &optional (y 'a y-p) (z 'b z-p))
243      `(list ',x ',y ',y-p ',z ',z-p))
244    (mapcar #'eval '((defmacro.18-macro p)
245                     (defmacro.18-macro p q)
246                     (defmacro.18-macro p q r))))
247  ((p a nil b nil)
248   (p q t b nil)
249   (p q t r t)))
250
251;;; Optional with destructuring
252(deftest defmacro.19
253  (progn
254    (defmacro defmacro.19-macro (&optional ((x . y) '(a . b)))
255      `(list ',x ',y))
256    (mapcar #'eval '((defmacro.19-macro)
257                     (defmacro.19-macro (c d)))))
258  ((a b) (c (d))))
259
260;;; Allow other keys
261
262(deftest defmacro.20
263  (progn
264    (defmacro defmacro.20-macro (&key x y z &allow-other-keys)
265      `(list ',x ',y ',z))
266    (mapcar #'eval '((defmacro.20-macro)
267                     (defmacro.20-macro :x a)
268                     (defmacro.20-macro :y b)
269                     (defmacro.20-macro :z c)
270                     (defmacro.20-macro :x a :y b)
271                     (defmacro.20-macro :z c :y b)
272                     (defmacro.20-macro :z c :x a)
273                     (defmacro.20-macro :z c :x a :y b)
274                     (defmacro.20-macro nil nil)
275                     (defmacro.20-macro :allow-other-keys nil)
276                     (defmacro.20-macro :allow-other-keys nil :foo bar)
277                     (defmacro.20-macro :z c :z nil :x a :abc 0 :y b :x t))))
278  ((nil nil nil)
279   (a nil nil)
280   (nil b nil)
281   (nil nil c)
282   (a b nil)
283   (nil b c)
284   (a nil c)
285   (a b c)
286   (nil nil nil)
287   (nil nil nil)
288   (nil nil nil)
289   (a b c)))
290
291(deftest defmacro.21
292  (progn
293    (defmacro defmacro.21-macro (&key x y z)
294      `(list ',x ',y ',z))
295    (mapcar #'eval '((defmacro.21-macro)
296                     (defmacro.21-macro :x a)
297                     (defmacro.21-macro :y b)
298                     (defmacro.21-macro :z c)
299                     (defmacro.21-macro :x a :y b)
300                     (defmacro.21-macro :z c :y b)
301                     (defmacro.21-macro :z c :x a)
302                     (defmacro.21-macro :z c :x a :y b)
303                     (defmacro.21-macro :allow-other-keys nil)
304                     (defmacro.21-macro :allow-other-keys t :foo bar))))
305  ((nil nil nil)
306   (a nil nil)
307   (nil b nil)
308   (nil nil c)
309   (a b nil)
310   (nil b c)
311   (a nil c)
312   (a b c)
313   (nil nil nil)
314   (nil nil nil)))
315
316                     
317                     
318           
Note: See TracBrowser for help on using the repository browser.