1 ;;;; Compiler-macro tests
3 ;;; taken from CLHS example
7 (define-compiler-macro square
(&whole form arg
)
11 (square (if (= (length arg
) 2)
12 `(expt ,(nth 1 arg
) 4)
14 (expt (if (= (length arg
) 3)
15 (if (numberp (nth 2 arg
))
16 `(expt ,(nth 1 arg
) ,(* 2 (nth 2 arg
)))
17 `(expt ,(nth 1 arg
) (* 2 ,(nth 2 arg
))))
19 (otherwise `(expt ,arg
2)))))
21 (assert (eql 81 (square (square 3))))
23 (multiple-value-bind (expansion expanded-p
) (macroexpand '(square x
))
24 (assert (equal '(square x
) expansion
))
25 (assert (not expanded-p
)))
27 (assert (equal '(expt x
2)
28 (funcall (compiler-macro-function 'square
)
32 (assert (equal '(expt x
4)
33 (funcall (compiler-macro-function 'square
)
37 (assert (equal '(expt x
2)
38 (funcall (compiler-macro-function 'square
)
42 (with-test (:name
:cannot-define-macro-for-special-form
)
43 ;; DEFINE-COMPILER-MACRO is unusual in that it won't even expand
44 ;; if its first argument names a special operator at expansion time.
45 (assert-error (macroexpand-1
46 '(define-compiler-macro catch
(foo &rest bar
)))))
48 (defmacro test-macro
() 1)
49 (define-compiler-macro test-macro
() 2)
51 (with-test (:name
:funcall-macro-with-compiler-macro
)
52 (assert-error (funcall (compile nil
`(lambda () (funcall #'test-macro
)))))
53 (assert-error (funcall (compile nil
`(lambda () (funcall 'test-macro
))))))