diff --git a/ansi-tests/define-compiler-macro.lsp b/ansi-tests/define-compiler-macro.lsp index 5e3dcb03a38e0047b2bbf28e57b89ffb99b91e8b..c27f321cd2cbe4c575b1a114412e2376ad32d927 100644 --- a/ansi-tests/define-compiler-macro.lsp +++ b/ansi-tests/define-compiler-macro.lsp @@ -24,3 +24,65 @@ nil nil) program-error) t) + +;;; Non-error tests + +(deftest define-compiler-macro.1 + (let* ((sym (gensym)) + (macro-def-form + `(define-compiler-macro ,sym (x y) + (declare (special *x*)) + (setf *x* t) + `(+ ,x ,y 1))) + (fun-def-form + `(defun ,sym (x y) (+ x y 1)))) + (values + (equalt (list sym) (multiple-value-list (eval fun-def-form))) + (equalt (list sym) (multiple-value-list (eval macro-def-form))) + (notnot (typep (compiler-macro-function sym) 'function)) + (eval `(,sym 6 19)) + (let ((fn (compile nil `(lambda (a b) (,sym a b))))) + (let ((*x* nil)) + (declare (special *x*)) + (list (funcall fn 12 123) *x*))))) + t t t 26 (136 nil)) + +(deftest define-compiler-macro.2 + (let* ((sym (gensym)) + (macro-def-form + `(define-compiler-macro ,sym (&whole form &rest args) + (declare (special *x*) (ignore args)) + (setf *x* t) + (return-from ,sym form))) + (fun-def-form + `(defun ,sym (x) x))) + (values + (equalt (list sym) (multiple-value-list (eval fun-def-form))) + (equalt (list sym) (multiple-value-list (eval macro-def-form))) + (notnot (typep (compiler-macro-function sym) 'function)) + (eval `(,sym 'a)) + (let ((fn (compile nil `(lambda (a) (,sym a))))) + (let ((*x* nil)) + (declare (special *x*)) + (list (funcall fn 'b) *x*))))) + t t t a (b nil)) + +(deftest define-compiler-macro.3 + (let* ((sym (gensym)) + (macro-def-form + `(define-compiler-macro ,sym (&whole form &rest args) + (declare (special *x*) (ignore args)) + (setf *x* t) + (return-from ,sym form))) + (ordinary-macro-def-form + `(defmacro ,sym (x) x))) + (values + (equalt (list sym) (multiple-value-list (eval ordinary-macro-def-form))) + (equalt (list sym) (multiple-value-list (eval macro-def-form))) + (notnot (typep (compiler-macro-function sym) 'function)) + (eval `(,sym 'a)) + (let ((fn (compile nil `(lambda (a) (,sym a))))) + (let ((*x* nil)) + (declare (special *x*)) + (list (funcall fn 'b) *x*))))) + t t t a (b nil))