Skip to content
Snippets Groups Projects
Commit a08f4b9f authored by pfdietz's avatar pfdietz
Browse files

Begin adding non-error tests of DEFINE-COMPILE-MACRO

parent b48cf534
No related branches found
No related tags found
No related merge requests found
......@@ -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))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment