Avoid forward references to PARSE-mumble-TYPE condition classes.
[sbcl.git] / tests / define-compiler-macro.impure.lisp
blob0f197a7bcc41dfd88e44e3d9ec116b2755924703
1 ;;;; Compiler-macro tests
3 ;;; taken from CLHS example
4 (defun square (x)
5 (expt x 2))
7 (define-compiler-macro square (&whole form arg)
8 (if (atom arg)
9 `(expt ,arg 2)
10 (case (car arg)
11 (square (if (= (length arg) 2)
12 `(expt ,(nth 1 arg) 4)
13 form))
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))))
18 form))
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)
29 '(square x)
30 nil)))
32 (assert (equal '(expt x 4)
33 (funcall (compiler-macro-function 'square)
34 '(square (square x))
35 nil)))
37 (assert (equal '(expt x 2)
38 (funcall (compiler-macro-function 'square)
39 '(funcall #'square x)
40 nil)))
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))))))