Fixed eval-when special form and added tests to prevent future breakage.

[clinton/parenscript.git] / t / ps-tests.lisp

diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index 291a95e..3cd58dc 100644 (file)
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -1106,3 +1106,72 @@ var x1 = function (x) {
 };
 x1(x);")
 
+(test-ps-js macrolet-let-inteference
+  (macrolet ((a (n) `(+ ,n 5)))
+    (let ((a (a 1)))
+      (let ((b (a (- a 4))))
+        (+ a b))))
+  "var a = 1 + 5;
+var b = (a - 4) + 5;
+a + b;")
+
+(test-ps-js let-subtract-add
+  (let ((x 1))
+    (let ((x 2))
+      (- x x)
+      (- x)
+      (decf x)
+      (incf x)))
+  "var x = 1;
+var x1 = 2;
+x1 - x1;
+-x1;
+--x1;
+++x1;")
+
+(test-ps-js create-reserved-word
+  (create :default 1)
+  "{ 'default' : 1 };")
+
+(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*))))