/[gcl]/gcl/ansi-tests/define-compiler-macro.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/define-compiler-macro.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by pfdietz, Sat Jan 17 12:44:01 2004 UTC revision 1.3 by pfdietz, Sun May 15 12:22:24 2005 UTC
# Line 24  Line 24 
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))

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26