[parenscript-devel] Inconsistency between (slot-value obj :keyword-symbol) and :keyword-symbol. Patch attached
Red Daly
reddaly at gmail.com
Sun Jul 26 20:52:21 UTC 2009
Dear Parenscripters,
I found an inconsistency in how symbols are translated into Javascript. The
issue is similar to an earlier issue:
CL-USER>
(ps:ps
(let ((sym
:my-function))
(slot-value object
sym)
(slot-value object :my-function)))
"var sym =
'my-function';
object[sym];
object.myFunction;"
One would expect object[sym] and object.myFunction to evaluate to the same
value, but right now they do not. This bug only affects keywords:
CL-USER>
(ps:ps
(let ((sym
'my-function))
(slot-value object
sym)
(slot-value object 'my-function)))
"var sym =
'myFunction';
object[sym];
object.myFunction;"
The above output is sensible. A patch is attached to fix this issue. A few
test cases have also been added to prevent future breakage.
The old DEFUN-KEYWORD4 test function failed with this patch because it
expected a keyword to translate to 'my-name-key'. I patched it to expect
'myNameKey'
Best,
Red
>From 904be1cc2eee598491557132e8ed1569a90f27a3 Mon Sep 17 00:00:00 2001
From: Red Daly <reddaly at gmail.com>
Date: Sun, 26 Jul 2009 20:22:54 +0000
Subject: [PATCH] Fixed eval-when special form and added tests to prevent
future breakage.
---
src/compiler.lisp | 50 ++++++++++++++++++++++++++++----------------------
t/ps-tests.lisp | 40 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 68 insertions(+), 22 deletions(-)
diff --git a/src/compiler.lisp b/src/compiler.lisp
index 4fed094..e72fb4e 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -162,17 +162,20 @@ compiled to an :expression (the default), a
:statement, or a
:symbol."))
(defun adjust-ps-compilation-level (form level)
- (cond ((or (and (consp form) (eq 'progn (car form)))
- (and (symbolp form) (eq :toplevel level)))
- level)
- ((eq :toplevel level) :inside-toplevel-form)))
+ "Given the current *ps-compilation-level*, LEVEL, and the fully
macroexpanded
+form, FORM, returns the new value for *ps-compilation-level*."
+ (cond ((or (and (consp form) (member (car form)
+ '(progn locally macrolet symbol-macrolet
compile-file)))
+ (and (symbolp form) (eq :toplevel level)))
+ level)
+ ((eq :toplevel level) :inside-toplevel-form)))
+
(defmethod compile-parenscript-form :around (form &key expecting)
(assert (if expecting (member expecting '(:expression :statement
:symbol)) t))
(if (eq expecting :symbol)
(compile-to-symbol form)
- (let ((*ps-compilation-level* (adjust-ps-compilation-level form
*ps-compilation-level*)))
- (call-next-method))))
+ (call-next-method)))
(defun compile-to-symbol (form)
"Compiles the given Parenscript form and guarantees that the
@@ -226,22 +229,25 @@ the form cannot be compiled to a symbol."
(defmethod compile-parenscript-form ((form cons) &key (expecting
:statement))
(multiple-value-bind (form expanded-p)
(ps-macroexpand form)
- (cond (expanded-p (compile-parenscript-form form :expecting expecting))
- ((ps-special-form-p form) (apply (get-ps-special-form (car form))
(cons expecting (cdr form))))
- ((op-form-p form)
- `(js:operator ,(ps-convert-op-name (compile-parenscript-form
(car form) :expecting :symbol))
- ,@(mapcar (lambda (form)
- (compile-parenscript-form
(ps-macroexpand form) :expecting :expression))
- (cdr form))))
- ((funcall-form-p form)
- `(js:funcall ,(compile-parenscript-form (if (symbolp (car form))
-
(maybe-rename-local-function (car form))
- (ps-macroexpand (car
form)))
- :expecting :expression)
- ,@(mapcar (lambda (arg)
- (compile-parenscript-form
(ps-macroexpand arg) :expecting :expression))
- (cdr form))))
- (t (error "Cannot compile ~S to a ParenScript form." form)))))
+ (let ((*ps-compilation-level* (if expanded-p
+ *ps-compilation-level*
+ (adjust-ps-compilation-level form
*ps-compilation-level*))))
+ (cond (expanded-p (compile-parenscript-form form :expecting
expecting))
+ ((ps-special-form-p form) (apply (get-ps-special-form (car form))
(cons expecting (cdr form))))
+ ((op-form-p form)
+ `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car
form) :expecting :symbol))
+ ,@(mapcar (lambda (form)
+ (compile-parenscript-form (ps-macroexpand form)
:expecting :expression))
+ (cdr form))))
+ ((funcall-form-p form)
+ `(js:funcall ,(compile-parenscript-form (if (symbolp (car form))
+ (maybe-rename-local-function (car form))
+ (ps-macroexpand (car form)))
+ :expecting :expression)
+ ,@(mapcar (lambda (arg)
+ (compile-parenscript-form (ps-macroexpand arg)
:expecting :expression))
+ (cdr form))))
+ (t (error "Cannot compile ~S to a ParenScript form." form))))))
(defvar *ps-gensym-counter* 0)
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index cd9d4f2..0324c09 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -1129,3 +1129,43 @@ x1 - x1;
--x1;
++x1;")
+(test-ps-js eval-when-ps-side
+ (eval-when (:execute)
+ 5)
+ "5;")
+
+(defvar *lisp-output* nil)
+
+(test eval-when-lisp-side ()
+ (setf *lisp-output* 'original-value)
+ (let ((js-output (normalize-js-code
+ (ps-doc* `(eval-when (:compile-toplevel)
+ (setf *lisp-output* 'it-works))))))
+ (is (eql 'it-works *lisp-output*))
+ (is (string= "" js-output))))
+
+(defpsmacro my-in-package (package-name)
+ `(eval-when (:compile-toplevel)
+ (setf *lisp-output* ,package-name)))
+
+(test eval-when-macro-expansion ()
+ (setf *lisp-output* 'original-value)
+ (let ((js-output (normalize-js-code
+ (ps-doc* `(progn
+ (my-in-package :cl-user)
+ 3)))))
+ (declare (ignore js-output))
+ (is (eql :cl-user *lisp-output*))))
+ ;(is (string= "" js-output))))
+
+(test eval-when-macrolet-expansion ()
+ (setf *lisp-output* 'original-value)
+ (let ((js-output (normalize-js-code
+ (ps-doc* `(macrolet ((my-in-package2 (package-name)
+ `(eval-when (:compile-toplevel)
+ (setf *lisp-output* ,package-name))))
+ (my-in-package2 :cl-user)
+ 3)))))
+ (declare (ignore js-output))
+ (is (eql :cl-user *lisp-output*))))
+ ;(is (string= "" js-output))))
--
1.5.4.3
>From d6748a5cfc8c4b9300884e9e5061db19cb0407cd Mon Sep 17 00:00:00 2001
From: Red Daly <reddaly at gmail.com>
Date: Sun, 26 Jul 2009 20:49:59 +0000
Subject: [PATCH] Fixed keyword translation inconsistency between (slot-value
object :key-thing) and :key-thing.
---
src/printer.lisp | 2 +-
src/special-forms.lisp | 2 +-
t/ps-tests.lisp | 18 +++++++++++++++++-
3 files changed, 19 insertions(+), 3 deletions(-)
diff --git a/src/printer.lisp b/src/printer.lisp
index b649dae..edf74b2 100644
--- a/src/printer.lisp
+++ b/src/printer.lisp
@@ -43,7 +43,7 @@ arguments, defines a printer for that form using the given
body."
(defmethod ps-print ((s symbol))
(assert (keywordp s))
- (ps-print (string-downcase s)))
+ (ps-print (symbol-to-js-string s)))
(defmethod ps-print ((compiled-form cons))
(ps-print% (car compiled-form) (cdr compiled-form)))
diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index 802dc28..e96a6d4 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -34,7 +34,7 @@
(typecase x
(cons `(array ,@(mapcar (lambda (x) (when x `',x)) x)))
(null '(array))
- (keyword x)
+ (keyword (symbol-to-js-string x))
(symbol (symbol-to-js-string x))
(number x)
(string x))
diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 0324c09..540d1a6 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -455,7 +455,7 @@ __setf_someThing(_js1, _js2, _js3);")
var _js2 = arguments.length;
for (var n1 = 0; n1 < _js2; n1 += 2) {
switch (arguments[n1]) {
- case 'my-name-key':
+ case 'myNameKey':
{
myName = arguments[n1 + 1];
};
@@ -1169,3 +1169,19 @@ x1 - x1;
(declare (ignore js-output))
(is (eql :cl-user *lisp-output*))))
;(is (string= "" js-output))))
+
+(test-ps-js keyword-conversion1
+ :alpha-omega
+ "'alphaOmega';")
+
+(test-ps-js keyword-conversion2
+ (slot-value object :alpha-omega)
+ "object.alphaOmega;")
+
+(test keyword-conversion2 ()
+ (let ((js-output1 (normalize-js-code
+ (ps-doc* '(slot-value object :alpha-omega))))
+ (js-output2 (normalize-js-code
+ (ps-doc* :alpha-omega)))
+ (declare (ignore js-output))
+ (is (eql :cl-user *lisp-output*))))
--
1.5.4.3
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/parenscript-devel/attachments/20090726/1cfdc19c/attachment.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: keyword-translation-bug.diff
Type: text/x-patch
Size: 7951 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/parenscript-devel/attachments/20090726/1cfdc19c/attachment.bin>
More information about the parenscript-devel
mailing list