Fixed non-uniform handling of quoted symbols that manifested itself in
authorVladimir Sedach <vsedach@gmail.com>
Wed, 29 Apr 2009 01:22:36 +0000 (19:22 -0600)
committerVladimir Sedach <vsedach@gmail.com>
Wed, 29 Apr 2009 01:22:36 +0000 (19:22 -0600)
broken package obfuscation.

Thanks to Red Daly for the bug report.

src/namespace.lisp
src/printer.lisp
src/special-forms.lisp
src/utils.lisp
t/package-system-tests.lisp

index dfeba9d..4bc2798 100644 (file)
@@ -29,8 +29,8 @@
 designated package when translating ParenScript code."
   `(gethash (find-package ,package) *package-prefix-table*))
 
-(defun js-translate-symbol (symbol)
-  (let ((possibly-obfuscated-symbol (maybe-obfuscate-symbol symbol)))
-    (if (ps-package-prefix (symbol-package symbol))
-        (format nil "~A~A" (ps-package-prefix (symbol-package symbol)) (symbol-to-js-string possibly-obfuscated-symbol))
-        (symbol-to-js-string possibly-obfuscated-symbol))))
+(defun symbol-to-js-string (symbol)
+  (let ((symbol-name (symbol-name-to-js-string (maybe-obfuscate-symbol symbol))))
+    (aif (ps-package-prefix (symbol-package symbol))
+         (format nil "~A~A" it symbol-name)
+         symbol-name)))
index 2f6e2a0..dbeea7a 100644 (file)
@@ -136,7 +136,7 @@ arguments, defines a printer for that form using the given body."
         (psw #\[) (ps-print idx) (psw #\])))
 
 (defprinter js:variable (var)
-  (psw (js-translate-symbol var)))
+  (psw (symbol-to-js-string var)))
 
 ;;; arithmetic operators
 (defun parenthesize-print (ps-form)
@@ -190,9 +190,9 @@ arguments, defines a printer for that form using the given body."
   (print-fun-def name args body))
 
 (defun print-fun-def (name args body-block)
-  (psw (format nil "function ~:[~;~A~](" name (js-translate-symbol name)))
+  (psw (format nil "function ~:[~;~A~](" name (symbol-to-js-string name)))
   (loop for (arg . remaining) on args do
-        (psw (js-translate-symbol arg)) (when remaining (psw ", ")))
+        (psw (symbol-to-js-string arg)) (when remaining (psw ", ")))
   (psw ") ")
   (ps-print body-block))
 
@@ -200,7 +200,7 @@ arguments, defines a printer for that form using the given body."
   (psw "{ ")
   (loop for ((slot-name . slot-value) . remaining) on slot-defs do
         (if (and (listp slot-name) (eq 'quote (car slot-name)) (symbolp (second slot-name)))
-            (psw (js-translate-symbol (second slot-name)))
+            (psw (symbol-to-js-string (second slot-name)))
             (ps-print slot-name))
         (psw " : ")
         (ps-print slot-value)
@@ -214,7 +214,7 @@ arguments, defines a printer for that form using the given body."
       (parenthesize-print obj)
       (ps-print obj))
   (if (symbolp slot)
-      (progn (psw #\.) (psw (js-translate-symbol slot)))
+      (progn (psw #\.) (psw (symbol-to-js-string slot)))
       (progn (psw #\[) (ps-print slot) (psw #\]))))
 
 (defprinter js:if (test consequent &rest clauses)
@@ -245,7 +245,7 @@ arguments, defines a printer for that form using the given body."
 
 (defprinter js:var (var-name &rest var-value)
   (psw "var ")
-  (psw (js-translate-symbol var-name))
+  (psw (symbol-to-js-string var-name))
   (when var-value
     (psw " = ")
     (ps-print (car var-value))))
@@ -254,21 +254,21 @@ arguments, defines a printer for that form using the given body."
   (psw "break")
   (when label
     (psw " ")
-    (psw (js-translate-symbol label))))
+    (psw (symbol-to-js-string label))))
 
 (defprinter js:continue (&optional label)
   (psw "continue")
   (when label
     (psw " ")
-    (psw (js-translate-symbol label))))
+    (psw (symbol-to-js-string label))))
 
 ;;; iteration
 (defprinter js:for (label vars tests steps body-block)
-  (when label (psw (js-translate-symbol label)) (psw ": ") (newline-and-indent))
+  (when label (psw (symbol-to-js-string label)) (psw ": ") (newline-and-indent))
   (psw "for (")
   (loop for ((var-name . var-init) . remaining) on vars
         for decl = "var " then "" do
-        (psw decl) (psw (js-translate-symbol var-name)) (psw " = ") (ps-print var-init) (when remaining (psw ", ")))
+        (psw decl) (psw (symbol-to-js-string var-name)) (psw " = ") (ps-print var-init) (when remaining (psw ", ")))
   (psw "; ")
   (loop for (test . remaining) on tests do
        (ps-print test) (when remaining (psw ", ")))
@@ -319,7 +319,7 @@ arguments, defines a printer for that form using the given body."
   (psw "try ")
   (ps-print body-block)
   (when catch
-    (psw " catch (") (psw (js-translate-symbol (first catch))) (psw ") ")
+    (psw " catch (") (psw (symbol-to-js-string (first catch))) (psw ") ")
     (ps-print (second catch)))
   (when finally
     (psw " finally ")
index a6d363f..e627c70 100644 (file)
@@ -28,7 +28,8 @@
   (typecase x
     (cons (cons 'array (mapcar (lambda (x) (when x `',x)) x)))
     (null '(array))
-    (symbol (string-downcase x))
+    (keyword x)
+    (symbol (symbol-to-js-string x))
     (number x)
     (string x)))
 
index 9a043d0..10aef94 100644 (file)
@@ -54,7 +54,7 @@
   (and (> (length string) 1)
        (char= #\: (char string 0))))
 
-(defun symbol-to-js-string (symbol)
+(defun symbol-name-to-js-string (symbol)
   "Given a Lisp symbol or string, produces to a valid JavaScript
 identifier by following transformation heuristics case conversion. For
 example, paren-script becomes parenScript, *some-global* becomes
@@ -95,7 +95,7 @@ SOMEGLOBAL."
                         (reschar i)))
                      (t (reschar c))))))
              (coerce (nreverse res) 'string)))
-          (t (string-join (mapcar #'symbol-to-js-string symbols) "")))))
+          (t (string-join (mapcar #'symbol-name-to-js-string symbols) "")))))
 
 (defun ordered-set-difference (list1 list2 &key (test #'eql)) ; because the CL set-difference may not preserve order
   (reduce (lambda (list el) (remove el list :test test))
index 238c33d..05b9328 100644 (file)
@@ -1,4 +1,4 @@
-(in-package :parenscript-test)
+(in-package "PARENSCRIPT-TEST")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (def-suite package-system-tests))
         return x + y;
      }")
 
+(test-ps-js uniform-symbol-handling1
+  (progn (create 'ps-test.my-library::foo 1)
+         (create ps-test.my-library::foo 1)
+         (slot-value foo 'ps-test.my-library::foo))
+  "{ 'my_library_foo' : 1 };
+{ my_library_foo : 1 };
+foo.my_library_foo;")
+
 (defpackage "PS-TEST.OBFUSCATE-ME")
 (obfuscate-package "PS-TEST.OBFUSCATE-ME")