tests/define-compiler-macro.impure.lisp

   1 ;;;; Compiler-macro tests
   2
   3 ;;; taken from CLHS example
   4 (defun square (x)
   5   (expt x 2))
   6
   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)))))
  20
  21 (assert (eql 81 (square (square 3))))
  22
  23 (multiple-value-bind (expansion expanded-p) (macroexpand '(square x))
  24   (assert (equal '(square x) expansion))
  25   (assert (not expanded-p)))
  26
  27 (assert (equal '(expt x 2)
  28                (funcall (compiler-macro-function 'square)
  29                         '(square x)
  30                         nil)))
  31
  32 (assert (equal '(expt x 4)
  33                (funcall (compiler-macro-function 'square)
  34                         '(square (square x))
  35                         nil)))
  36
  37 (assert (equal '(expt x 2)
  38                (funcall (compiler-macro-function 'square)
  39                         '(funcall #'square x)
  40                         nil)))
  41
  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)))))
  47
  48 (defmacro test-macro () 1)
  49 (define-compiler-macro test-macro () 2)
  50
  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))))))