X-Git-Url: https://git.hcoop.net/clinton/parenscript.git/blobdiff_plain/837bcc37c5a8727b89a99523d215f6769ff38389..2471a2cf648569db98e3a89a15849f9164edd1b4:/t/ps-tests.lisp

diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 239797b..2350f03 100644
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -55,7 +55,7 @@ x = 2 + sideEffect() + x + 5;")
   "'hi'.toString();")
 
 (test-ps-js method-call-lit-object
-  ((@ (create :to-string (lambda () (return "it works"))) to-string))
+  ((@ (create to-string (lambda () (return "it works"))) to-string))
   "( { toString : function () { return 'it works'; } } ).toString();")
 
 (test-ps-js method-call-conditional
@@ -90,13 +90,13 @@ x = 2 + sideEffect() + x + 5;")
     (is (char= char-before a-parenthesis))))
 
 (test-ps-js simple-slot-value
-  (let ((foo (create :a 1)))
+  (let ((foo (create a 1)))
     (alert (slot-value foo 'a)))
   "var foo = { a : 1 };
    alert(foo.a);")
 
 (test-ps-js buggy-slot-value
-   (let ((foo (create :a 1))
+   (let ((foo (create a 1))
          (slot-name "a"))
     (alert (slot-value foo slot-name)))
   " var foo = { a : 1 };
@@ -516,9 +516,16 @@ __setf_someThing(_js1, _js2, _js3);")
 };")
 
 (test-ps-js cond-expression-final-t-clause
-  (defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)) ((= a b) (+ c d)) ((< 1 2 3 4 5) x) (t "foo"))))
+  (defun foo ()
+    (return (cond ((< 1 2) (bar "foo") (* 4 5))
+                  ((= a b) (+ c d))
+                  ((< 1 2 3 4 5) x)
+                  (t "foo"))))
   "function foo() {
-    return 1 < 2 ? (bar('foo'), 4 * 5) : (a == b ? c + d : (1 < 2 < 3 < 4 < 5 ? x : 'foo'));
+    var _cmp3;
+    var _cmp2;
+    var _cmp1;
+    return 1 < 2 ? (bar('foo'), 4 * 5) : (a == b ? c + d : ((_cmp1 = 2, _cmp2 = 3, _cmp3 = 4, 1 < _cmp1 && _cmp1 < _cmp2 && _cmp2 < _cmp3 && _cmp3 < 5) ? x : 'foo'));
 };")
 
 (test-ps-js cond-expression-middle-t-clause ;; should this signal a warning?
@@ -534,7 +541,7 @@ __setf_someThing(_js1, _js2, _js3);")
                      :onclick (ps-inline (transport)))
                  img))
        img))
-  "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">' + img + '</A>' : img);")
+  "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport()') + '\">' + img + '</A>' : img);")
 
 (test-ps-js negate-number-literal ;; ok, this was broken and fixed before, but no one bothered to add the test!
   (- 1)
@@ -742,7 +749,7 @@ try {
   "(window.eval || eval)()(foo, null);")
 
 (test-ps-js slot-value-object-literal
-  (slot-value (create :a 1) 'a)
+  (slot-value (create a 1) 'a)
   "({ a : 1 }).a;")
 
 (test-ps-js slot-value-lambda
@@ -1136,3 +1143,65 @@ x1 - x1;
 (test-ps-js slot-value-reserved-word
   (slot-value foo :default)
   "foo['default'];")
+
+(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*))))
+
+(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*))))
+
+(test-ps-js slot-value-keyword
+  (slot-value foo :bar)
+  "foo['bar'];")
+
+(test-ps-js nary-comparison1
+  (lambda () (return (< 1 2 3)))
+  "function () {
+    var _cmp1;
+    return (_cmp1 = 2, 1 < _cmp1 && _cmp1 < 3);
+};")
+
+(test-ps-js chain-slot-value1
+  (chain ($ "foo") (bar x z) frob (baz 5))
+  "$('foo').bar(x, z).frob.baz(5);")
+
+(test-ps-js chain-slot-value2
+  (chain ($ "foo") bar baz)
+  "$('foo').bar.baz;")
+
+(test-ps-js chain-slot-value3
+  (chain ($ "foo") bar (x y) baz)
+  "$('foo').bar.x(y).baz;")