X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fmacroexpand.impure.lisp;h=3df0bdda7ec511b31ca61feb86af6f3e6871a907;hb=d7875c296a4988e9f27e2776237884deb1984c62;hp=6f5863d4ed31a825d00a4043faa40f44a5779f29;hpb=65e947c7a90df88e0691e664f3387ccb35d390d9;p=sbcl.git

diff --git a/tests/macroexpand.impure.lisp b/tests/macroexpand.impure.lisp
index 6f5863d..3df0bdd 100644
--- a/tests/macroexpand.impure.lisp
+++ b/tests/macroexpand.impure.lisp
@@ -13,13 +13,13 @@
 
 ;;; From Matthew Swank on cll 2005-10-06
 
-(defmacro defglobal (name &optional value)
+(defmacro defglobal* (name &optional value)
   (let ((internal (gensym)))
     `(progn
        (defparameter ,internal ,value)
        (define-symbol-macro ,name ,internal))))
 
-(defglobal glob)
+(defglobal* glob)
 
 (assert (= (let ((glob 4)) glob)))
 (assert (null glob))
@@ -27,3 +27,42 @@
 (assert (null glob))
 (assert (equal (let ((glob nil)) (push 'foo glob) glob) '(foo)))
 (assert (null glob))
+
+
+
+;;; CLHS 3.1.2.1.1 specifies that symbol macro expansion must also
+;;; go through *MACROEXPAND-HOOK*. (2007-09-22, -TCR.)
+
+(define-symbol-macro .foo. 'foobar)
+
+(let* ((expanded-p nil)
+      (*macroexpand-hook* #'(lambda (fn form env)
+                              (when (eq form '.foo.)
+                                (setq expanded-p t))
+                              (funcall fn form env))))
+  (multiple-value-bind (expansion flag) (macroexpand '.foo.)
+    (assert (equal expansion '(quote foobar)))
+    (assert flag)
+    (assert expanded-p)))
+
+#+sb-eval
+(let ((sb-ext::*evaluator-mode* :interpret))
+  (let* ((expanded-p nil)
+         (*macroexpand-hook* #'(lambda (fn form env)
+                                 (when (eq form '.foo.)
+                                   (setq expanded-p t))
+                                 (funcall fn form env))))
+    (eval '.foo.)
+    (assert expanded-p)))
+
+(let* ((expanded-p nil)
+       (*macroexpand-hook* #'(lambda (fn form env)
+                               (when (eq form '/foo/)
+                                 (setq expanded-p t))
+                               (funcall fn form env))))
+  (compile nil '(lambda ()
+                 (symbol-macrolet ((/foo/ 'foobar))
+                   (macrolet ((expand (symbol &environment env)
+                                (macroexpand symbol env)))
+                     (expand /foo/)))))
+  (assert expanded-p))