24 |
nil nil) |
nil nil) |
25 |
program-error) |
program-error) |
26 |
t) |
t) |
27 |
|
|
28 |
|
;;; Non-error tests |
29 |
|
|
30 |
|
(deftest define-compiler-macro.1 |
31 |
|
(let* ((sym (gensym)) |
32 |
|
(macro-def-form |
33 |
|
`(define-compiler-macro ,sym (x y) |
34 |
|
(declare (special *x*)) |
35 |
|
(setf *x* t) |
36 |
|
`(+ ,x ,y 1))) |
37 |
|
(fun-def-form |
38 |
|
`(defun ,sym (x y) (+ x y 1)))) |
39 |
|
(values |
40 |
|
(equalt (list sym) (multiple-value-list (eval fun-def-form))) |
41 |
|
(equalt (list sym) (multiple-value-list (eval macro-def-form))) |
42 |
|
(notnot (typep (compiler-macro-function sym) 'function)) |
43 |
|
(eval `(,sym 6 19)) |
44 |
|
(let ((fn (compile nil `(lambda (a b) (,sym a b))))) |
45 |
|
(let ((*x* nil)) |
46 |
|
(declare (special *x*)) |
47 |
|
(list (funcall fn 12 123) *x*))))) |
48 |
|
t t t 26 (136 nil)) |
49 |
|
|
50 |
|
(deftest define-compiler-macro.2 |
51 |
|
(let* ((sym (gensym)) |
52 |
|
(macro-def-form |
53 |
|
`(define-compiler-macro ,sym (&whole form &rest args) |
54 |
|
(declare (special *x*) (ignore args)) |
55 |
|
(setf *x* t) |
56 |
|
(return-from ,sym form))) |
57 |
|
(fun-def-form |
58 |
|
`(defun ,sym (x) x))) |
59 |
|
(values |
60 |
|
(equalt (list sym) (multiple-value-list (eval fun-def-form))) |
61 |
|
(equalt (list sym) (multiple-value-list (eval macro-def-form))) |
62 |
|
(notnot (typep (compiler-macro-function sym) 'function)) |
63 |
|
(eval `(,sym 'a)) |
64 |
|
(let ((fn (compile nil `(lambda (a) (,sym a))))) |
65 |
|
(let ((*x* nil)) |
66 |
|
(declare (special *x*)) |
67 |
|
(list (funcall fn 'b) *x*))))) |
68 |
|
t t t a (b nil)) |
69 |
|
|
70 |
|
(deftest define-compiler-macro.3 |
71 |
|
(let* ((sym (gensym)) |
72 |
|
(macro-def-form |
73 |
|
`(define-compiler-macro ,sym (&whole form &rest args) |
74 |
|
(declare (special *x*) (ignore args)) |
75 |
|
(setf *x* t) |
76 |
|
(return-from ,sym form))) |
77 |
|
(ordinary-macro-def-form |
78 |
|
`(defmacro ,sym (x) x))) |
79 |
|
(values |
80 |
|
(equalt (list sym) (multiple-value-list (eval ordinary-macro-def-form))) |
81 |
|
(equalt (list sym) (multiple-value-list (eval macro-def-form))) |
82 |
|
(notnot (typep (compiler-macro-function sym) 'function)) |
83 |
|
(eval `(,sym 'a)) |
84 |
|
(let ((fn (compile nil `(lambda (a) (,sym a))))) |
85 |
|
(let ((*x* nil)) |
86 |
|
(declare (special *x*)) |
87 |
|
(list (funcall fn 'b) *x*))))) |
88 |
|
t t t a (b nil)) |