defmacro.lsp 9.72 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 12:35:24 2003
;;;; Contains: Tests of DEFMACRO

(in-package :cl-test)

(deftest defmacro.error.1
9
  (signals-error (funcall (macro-function 'defmacro))
sds's avatar
sds committed
10
                 program-error)
11
  t)
12 13

(deftest defmacro.error.2
14
  (signals-error (funcall (macro-function 'defmacro)
sds's avatar
sds committed
15 16
                           '(defmacro nonexistent-macro ()))
                 program-error)
17
  t)
18 19

(deftest defmacro.error.3
20
  (signals-error (funcall (macro-function 'defmacro)
sds's avatar
sds committed
21 22 23
                           '(defmacro nonexistent-macro ())
                           nil nil)
                 program-error)
24
  t)
pfdietz's avatar
pfdietz committed
25 26 27 28 29 30 31

;;; FIXME
;;; Need to add non-error tests

(deftest defmacro.1
  (progn
    (assert (eq (defmacro defmacro.1-macro (x y) `(list 1 ,x 2 ,y 3))
sds's avatar
sds committed
32
                'defmacro.1-macro))
pfdietz's avatar
pfdietz committed
33
    (assert (macro-function 'defmacro.1-macro))
pfdietz's avatar
pfdietz committed
34
    (eval `(defmacro.1-macro 'a 'b)))
pfdietz's avatar
pfdietz committed
35 36 37 38 39
  (1 a 2 b 3))

(deftest defmacro.2
  (progn
    (assert (eq (defmacro defmacro.2-macro (x y)
sds's avatar
sds committed
40 41
                  (return-from defmacro.2-macro `(cons ,x ,y)))
                'defmacro.2-macro))
pfdietz's avatar
pfdietz committed
42
    (assert (macro-function 'defmacro.2-macro))
pfdietz's avatar
pfdietz committed
43
    (eval `(defmacro.2-macro 'a 'b)))
pfdietz's avatar
pfdietz committed
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
  (a . b))

;;; The macro function is defined in the lexical environment in which
;;; the defmacro form occurs.
(deftest defmacro.3
  (let (fn)
    (let ((x 0))
      (setq fn #'(lambda (n) (setq x n)))
      (defmacro defmacro.3-macro () `',x))
    (values
     (eval '(defmacro.3-macro))
     (funcall fn 'a)
     (eval '(defmacro.3-macro))))
  0 a a)

;;; Declarations are allowed.

;;; Free special declarations do not apply to the forms
;;; in the lambda list
(deftest defmacro.4
  (let ((y :good))
    (assert (eq (defmacro defmacro.4-macro (&optional (x y))
sds's avatar
sds committed
66 67 68
                  (declare (special y))
                  x)
                'defmacro.4-macro))
pfdietz's avatar
pfdietz committed
69 70 71 72 73 74 75 76
    (let ((y :bad))
      (declare (special y))
      (values (macroexpand-1 '(defmacro.4-macro)))))
  :good)

(deftest defmacro.5
  (progn
    (assert (eq (defmacro defmacro.5-macro ()
sds's avatar
sds committed
77 78 79
                  (declare) (declare) "a doc string" (declare)
                  t)
                'defmacro.5-macro))
pfdietz's avatar
pfdietz committed
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
    (eval `(defmacro.5-macro)))
  t)

;;; &whole argument, top level
(deftest defmacro.6
  (progn
    (defmacro defmacro.6-macro (&whole w arg)
      `(list ',w ',arg))
    (eval `(defmacro.6-macro x)))
  ((defmacro.6-macro x) x))

;;; &whole argument in destructuring
(deftest defmacro.7
  (progn
    (defmacro defmacro.7-macro (arg1 (&whole w arg2))
      `(list ',w ',arg1 ',arg2))
    (eval `(defmacro.7-macro x (y))))
sds's avatar
sds committed
97
  ((y) x y))
pfdietz's avatar
pfdietz committed
98 99 100 101 102 103 104

;;; keyword parameters
(deftest defmacro.8
  (progn
    (defmacro defmacro.8-macro (&key foo bar)
      `(list ',foo ',bar))
    (mapcar #'eval '((defmacro.8-macro :foo x)
sds's avatar
sds committed
105 106 107
                     (defmacro.8-macro :bar y)
                     (defmacro.8-macro :bar a :foo b)
                     (defmacro.8-macro :bar a :foo b :bar c))))
pfdietz's avatar
pfdietz committed
108 109 110 111 112 113 114 115
  ((x nil) (nil y) (b a) (b a)))

;;; keyword parameters with default value
(deftest defmacro.9
  (progn
    (defmacro defmacro.9-macro (&key (foo 1) (bar 2))
      `(list ',foo ',bar))
    (mapcar #'eval '((defmacro.9-macro :foo x)
sds's avatar
sds committed
116 117 118 119 120
                     (defmacro.9-macro :bar y)
                     (defmacro.9-macro :foo nil)
                     (defmacro.9-macro :bar nil)
                     (defmacro.9-macro :bar a :foo b)
                     (defmacro.9-macro :bar a :foo b :bar c))))
pfdietz's avatar
pfdietz committed
121 122 123 124 125 126 127 128
  ((x 2) (1 y) (nil 2) (1 nil) (b a) (b a)))

;;; keyword parameters with supplied-p parameter
(deftest defmacro.10
  (progn
    (defmacro defmacro.10-macro (&key (foo 1 foo-p) (bar 2 bar-p))
      `(list ',foo ,(notnot foo-p) ',bar ,(notnot bar-p)))
    (mapcar #'eval '((defmacro.10-macro)
sds's avatar
sds committed
129 130 131 132 133 134 135 136
                     (defmacro.10-macro :foo x)
                     (defmacro.10-macro :bar y)
                     (defmacro.10-macro :foo nil)
                     (defmacro.10-macro :bar nil)
                     (defmacro.10-macro :foo x :bar y)
                     (defmacro.10-macro :bar y :foo x)
                     (defmacro.10-macro :bar a :bar b)
                     (defmacro.10-macro :foo a :foo b))))
pfdietz's avatar
pfdietz committed
137 138 139 140 141 142 143 144 145 146
  ((1 nil 2 nil) (x t 2 nil) (1 nil y t)
   (nil t 2 nil) (1 nil nil t) (x t y t)
   (x t y t) (1 nil a t) (a t 2 nil)))

;;; key arguments in destructuring

(deftest defmacro.11
  (progn
    (defmacro defmacro.11-macro ((&key foo bar)) `(list ',foo ',bar))
    (mapcar #'eval '((defmacro.11-macro nil)
sds's avatar
sds committed
147 148 149 150
                     (defmacro.11-macro (:foo x))
                     (defmacro.11-macro (:bar y))
                     (defmacro.11-macro (:foo x :bar y :foo z))
                     (defmacro.11-macro (:bar y :bar z :foo x)))))
pfdietz's avatar
pfdietz committed
151 152 153 154 155 156 157
  ((nil nil) (x nil) (nil y) (x y) (x y)))

;;;  key arguments in destructuring and defaults

(deftest defmacro.12
  (progn
    (let ((foo-default 1)
sds's avatar
sds committed
158
          (bar-default 2))
pfdietz's avatar
pfdietz committed
159
      (defmacro defmacro.12-macro ((&key (foo foo-default)
sds's avatar
sds committed
160 161
                                         (bar bar-default)))
        `(list ',foo ',bar)))
pfdietz's avatar
pfdietz committed
162
    (mapcar #'eval '((defmacro.12-macro nil)
sds's avatar
sds committed
163 164 165 166
                     (defmacro.12-macro (:foo x))
                     (defmacro.12-macro (:bar y))
                     (defmacro.12-macro (:foo x :bar y :foo z))
                     (defmacro.12-macro (:bar y :bar z :foo x)))))
pfdietz's avatar
pfdietz committed
167 168 169 170 171 172 173
  ((1 2) (x 2) (1 y) (x y) (x y)))

;;;  key arguments in destructuring and supplied-p parameter

(deftest defmacro.13
  (progn
    (let ((foo-default 1)
sds's avatar
sds committed
174
          (bar-default 2))
pfdietz's avatar
pfdietz committed
175
      (defmacro defmacro.13-macro ((&key (foo foo-default foo-p)
sds's avatar
sds committed
176 177
                                         (bar bar-default bar-p)))
        `(list ',foo ,(notnot foo-p) ',bar ,(notnot bar-p))))
pfdietz's avatar
pfdietz committed
178
    (mapcar #'eval '((defmacro.13-macro nil)
sds's avatar
sds committed
179 180 181 182 183 184
                     (defmacro.13-macro (:foo x))
                     (defmacro.13-macro (:bar y))
                     (defmacro.13-macro (:foo nil :bar nil :foo 4 :bar 14))
                     (defmacro.13-macro (:foo 1 :bar 2))
                     (defmacro.13-macro (:foo x :bar y :foo z))
                     (defmacro.13-macro (:bar y :bar z :foo x)))))
pfdietz's avatar
pfdietz committed
185 186 187 188 189 190 191 192 193 194
  ((1 nil 2 nil) (x t 2 nil) (1 nil y t)
   (nil t nil t) (1 t 2 t)
   (x t y t) (x t y t)))

;;; rest parameter
(deftest defmacro.14
  (progn
    (defmacro defmacro.14-macro (foo &rest bar)
      `(list ',foo ',bar))
    (mapcar #'eval '((defmacro.14-macro x)
sds's avatar
sds committed
195 196
                     (defmacro.14-macro x y)
                     (defmacro.14-macro x y z))))
pfdietz's avatar
pfdietz committed
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212
  ((x nil) (x (y)) (x (y z))))

;;; rest parameter with destructuring
(deftest defmacro.15
  (progn
    (defmacro defmacro.15-macro (foo &rest (bar . baz))
      `(list ',foo ',bar ',baz))
    (eval '(defmacro.15-macro x y z)))
  (x y (z)))

;;; rest parameter w. whole
(deftest defmacro.16
  (progn
    (defmacro defmacro.16-macro (&whole w foo &rest bar)
      `(list ',w ',foo ',bar))
    (mapcar #'eval '((defmacro.16-macro x)
sds's avatar
sds committed
213 214
                     (defmacro.16-macro x y)
                     (defmacro.16-macro x y z))))
pfdietz's avatar
pfdietz committed
215 216 217 218 219 220 221 222 223 224 225
  (((defmacro.16-macro x) x nil)
   ((defmacro.16-macro x y) x (y))
   ((defmacro.16-macro x y z) x (y z))))

;;; env parameter
(deftest defmacro.17
  (progn
    (defmacro defmacro.17-macro (x &environment env)
      `(quote ,(macroexpand x env)))
    (eval
     `(macrolet ((%m () :good))
sds's avatar
sds committed
226
        (defmacro.17-macro (%m)))))
pfdietz's avatar
pfdietz committed
227 228 229 230 231 232 233 234
  :good)

(deftest defmacro.17a
  (progn
    (defmacro defmacro.17a-macro (&environment env x)
      `(quote ,(macroexpand x env)))
    (eval
     `(macrolet ((%m () :good))
sds's avatar
sds committed
235
        (defmacro.17a-macro (%m)))))
pfdietz's avatar
pfdietz committed
236 237 238 239 240 241 242 243 244
  :good)

;;; &optional with supplied-p parameter
;;; Note: this is required to be T if the parameter is present (3.4.4.1.2)
(deftest defmacro.18
  (progn
    (defmacro defmacro.18-macro (x &optional (y 'a y-p) (z 'b z-p))
      `(list ',x ',y ',y-p ',z ',z-p))
    (mapcar #'eval '((defmacro.18-macro p)
sds's avatar
sds committed
245 246
                     (defmacro.18-macro p q)
                     (defmacro.18-macro p q r))))
pfdietz's avatar
pfdietz committed
247 248 249 250
  ((p a nil b nil)
   (p q t b nil)
   (p q t r t)))

pfdietz's avatar
pfdietz committed
251 252 253 254 255 256
;;; Optional with destructuring
(deftest defmacro.19
  (progn
    (defmacro defmacro.19-macro (&optional ((x . y) '(a . b)))
      `(list ',x ',y))
    (mapcar #'eval '((defmacro.19-macro)
sds's avatar
sds committed
257
                     (defmacro.19-macro (c d)))))
pfdietz's avatar
pfdietz committed
258 259 260 261 262 263 264 265 266
  ((a b) (c (d))))

;;; Allow other keys

(deftest defmacro.20
  (progn
    (defmacro defmacro.20-macro (&key x y z &allow-other-keys)
      `(list ',x ',y ',z))
    (mapcar #'eval '((defmacro.20-macro)
sds's avatar
sds committed
267 268 269 270 271 272 273 274 275 276 277
                     (defmacro.20-macro :x a)
                     (defmacro.20-macro :y b)
                     (defmacro.20-macro :z c)
                     (defmacro.20-macro :x a :y b)
                     (defmacro.20-macro :z c :y b)
                     (defmacro.20-macro :z c :x a)
                     (defmacro.20-macro :z c :x a :y b)
                     (defmacro.20-macro nil nil)
                     (defmacro.20-macro :allow-other-keys nil)
                     (defmacro.20-macro :allow-other-keys nil :foo bar)
                     (defmacro.20-macro :z c :z nil :x a :abc 0 :y b :x t))))
pfdietz's avatar
pfdietz committed
278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295
  ((nil nil nil)
   (a nil nil)
   (nil b nil)
   (nil nil c)
   (a b nil)
   (nil b c)
   (a nil c)
   (a b c)
   (nil nil nil)
   (nil nil nil)
   (nil nil nil)
   (a b c)))

(deftest defmacro.21
  (progn
    (defmacro defmacro.21-macro (&key x y z)
      `(list ',x ',y ',z))
    (mapcar #'eval '((defmacro.21-macro)
sds's avatar
sds committed
296 297 298 299 300 301 302 303 304
                     (defmacro.21-macro :x a)
                     (defmacro.21-macro :y b)
                     (defmacro.21-macro :z c)
                     (defmacro.21-macro :x a :y b)
                     (defmacro.21-macro :z c :y b)
                     (defmacro.21-macro :z c :x a)
                     (defmacro.21-macro :z c :x a :y b)
                     (defmacro.21-macro :allow-other-keys nil)
                     (defmacro.21-macro :allow-other-keys t :foo bar))))
pfdietz's avatar
pfdietz committed
305 306 307 308 309 310 311 312 313 314 315
  ((nil nil nil)
   (a nil nil)
   (nil b nil)
   (nil nil c)
   (a b nil)
   (nil b c)
   (a nil c)
   (a b c)
   (nil nil nil)
   (nil nil nil)))

sds's avatar
sds committed
316 317 318