From: Alexey D. <ade...@us...> - 2002-10-05 05:59:32
|
Update of /cvsroot/sbcl/sbcl/tests In directory usw-pr-cvs1:/tmp/cvs-serv24526/tests Modified Files: compiler.impure.lisp Added Files: defmacro-test.lisp Log Message: 0.7.8.16: DEFMACRO is implemented via EVAL-WHEN ... removed IR1 translator of %DEFMACRO ... removed %%DEFMACRO; its functionality is moved into %DEFMACRO --- NEW FILE: defmacro-test.lisp --- ;;;; Test of non-toplevel DEFMACRO (cl:in-package :cl-user) (eval-when (:compile-toplevel) (defun defmacro-test-aux (x) (setq *defmacro-test-status* `(function ,x)) nil)) (let ((z 'z-value)) (defmacro defmacro-test-aux (x) (setq *defmacro-test-status* `(macro ,x ,z)) `(setq *defmacro-test-status* '(expanded ,x ,z)))) (eval-when (:compile-toplevel) (defmacro-test-aux 'a)) Index: compiler.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- compiler.impure.lisp 2 Oct 2002 15:24:17 -0000 1.25 +++ compiler.impure.lisp 5 Oct 2002 05:59:28 -0000 1.26 @@ -439,6 +439,28 @@ (declare (type (and function (satisfies bug199-aux)) f)) (funcall f x)) +;;; check non-toplevel DEFMACRO +(defvar *defmacro-test-status* nil) + +(defun defmacro-test () + (fmakunbound 'defmacro-test-aux) + (let* ((src "defmacro-test.lisp") + (obj (compile-file-pathname src))) + (unwind-protect + (progn + (compile-file src) + (assert (equal *defmacro-test-status* '(function a))) + (setq *defmacro-test-status* nil) + (load obj) + (assert (equal *defmacro-test-status* nil)) + (macroexpand '(defmacro-test-aux 'a)) + (assert (equal *defmacro-test-status* '(macro 'a z-value))) + (eval '(defmacro-test-aux 'a)) + (assert (equal *defmacro-test-status* '(expanded 'a z-value)))) + (ignore-errors (delete-file obj))))) + +(defmacro-test) + ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself |