diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-02 20:53:39 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-02 20:53:39 +0100 |
| commit | fbc1ec5ed1a48ee3536849eb3665c9275c3986fd (patch) | |
| tree | 87e34bed93a79714c5dd933a31f8afb4c6655af2 | |
| parent | 5ce666fc19c76a234df7819e9be1d2cb07c0c6cf (diff) | |
Fix the compiler macro for INVOKE.
darcs-hash:f76cc3530507e408704652d52b86b434e508c18d
| -rw-r--r-- | Lisp/compiler-macros.lisp | 12 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 35 |
2 files changed, 40 insertions, 7 deletions
diff --git a/Lisp/compiler-macros.lisp b/Lisp/compiler-macros.lisp index 5ee8082..2ed4b0d 100644 --- a/Lisp/compiler-macros.lisp +++ b/Lisp/compiler-macros.lisp @@ -66,11 +66,9 @@ (define-compiler-macro invoke (&whole form receiver message-start &rest message-components) (multiple-value-bind (method-name args) - (split-method-call (if (and (consp message-start) - (eq (first message-start) 'quote)) - (second message-start) - message-start) - message-components) - (if (constantp method-name) - `(invoke-by-name ,receiver (selector ',method-name) ,@args) + (split-method-call message-start message-components) + (if (and (listp method-name) + (every #'constantp method-name)) + `(invoke-by-name ,receiver (selector ',(mapcar #'eval method-name)) + ,@args) form))) diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index 0bdd750..f5344df 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -361,6 +361,41 @@ 'self))))) +(deftest compiler-macros () + (flet ((compiler-macroexpand-1 (form &optional environment) + (funcall (or (compiler-macro-function (car form)) + #'(lambda (x y) (declare (ignore y)) x)) + form + environment))) + (is (equal (compiler-macroexpand-1 '(invoke x :is-equal y) nil) + `(invoke-by-name x (selector '(:is-equal)) y))) + (is (equal (compiler-macroexpand-1 '(invoke x 'self)) + `(invoke-by-name x (selector '(self))))) + (is (equal (compiler-macroexpand-1 `(invoke x + :string-with-c-string "Mulk." + :encoding 4)) + `(invoke-by-name x + (selector '(:string-with-c-string :encoding)) + "Mulk." + 4))) + (is (equal (compiler-macroexpand-1 `(invoke-by-name (+ 1 2) 'self)) + `(invoke-by-name (+ 1 2) (selector 'self)))) + (is (equal (compiler-macroexpand-1 `(invoke-by-name (+ 1 2) '(:foo :bar) + x y)) + `(invoke-by-name (+ 1 2) (selector '(:foo :bar)) x y))) + (is (equal (compiler-macroexpand-1 `(primitive-invoke (+ 1 2) '(:foo :bar) + x y)) + `(primitive-invoke (+ 1 2) (selector '(:foo :bar)) x y))) + (is (equal (car (compiler-macroexpand-1 `(selector '(:foo :bar)))) + 'load-time-value)) + (is (not (equal (car (compiler-macroexpand-1 `(selector (:foo :bar)))) + 'load-time-value))) + (is (not (equal (car (compiler-macroexpand-1 `(selector (car '(:foo :bar))))) + 'load-time-value))) + (is (not (equal (car (compiler-macroexpand-1 `(selector `(,x ,y)))) + 'load-time-value))))) + + (defvar *class-counter* 0) |