summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-02 20:53:39 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-02 20:53:39 +0100
commitfbc1ec5ed1a48ee3536849eb3665c9275c3986fd (patch)
tree87e34bed93a79714c5dd933a31f8afb4c6655af2
parent5ce666fc19c76a234df7819e9be1d2cb07c0c6cf (diff)
Fix the compiler macro for INVOKE.
darcs-hash:f76cc3530507e408704652d52b86b434e508c18d
-rw-r--r--Lisp/compiler-macros.lisp12
-rw-r--r--Lisp/tests.lisp35
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)