Substantially modified the way Parenscript compilation and
[clinton/parenscript.git] / t / reference-tests.lisp
index 8c2cdb7..f749d18 100644 (file)
@@ -9,87 +9,86 @@
 
 (test-ps-js statements-and-expressions-1
   (+ i (if 1 2 3))
-  "i + (1 ? 2 : 3)")
+  "i + (1 ? 2 : 3);")
 
 (test-ps-js statements-and-expressions-2
   (if 1 2 3)
   "if (1) {
-  2;
+    2;
 } else {
-  3;
-}")
+    3;
+};")
 
 (test-ps-js symbol-conversion-1
   !?#@%
-  "bangwhathashatpercent")
+  "bangwhathashatpercent;")
 
 (test-ps-js symbol-conversion-2
   bla-foo-bar
-  "blaFooBar")
+  "blaFooBar;")
 
 (test-ps-js symbol-conversion-3
   *array
-  "Array")
+  "Array;")
 
-(test-ps-js symbol-conversion-6
+(test-ps-js symbol-conversion-4
   *global-array*
-  "GLOBALARRAY")
-
-(test-ps-js symbol-conversion-7
-  *global-array*.length
-  "GLOBALARRAY.length")
+  "GLOBALARRAY;")
 
 (test-ps-js number-literals-1
   1
-  "1")
+  "1;")
 
 (test-ps-js number-literals-2
   123.123
-  "123.123")
+  "123.123;")
 
 (test-ps-js number-literals-3
   #x10
-  "16")
+  "16;")
 
 (test-ps-js string-literals-1
   "foobar"
-  "'foobar'")
+  "'foobar';")
 
 (test-ps-js string-literals-2
   "bratzel bub"
-  "'bratzel bub'")
+  "'bratzel bub';")
+
+(test-ps-js string-literals-3
+  "    "
+  "'\\t';")
 
 (test-ps-js array-literals-1
   (array)
-  "[  ]")
+  "[  ];")
 
 (test-ps-js array-literals-2
   (array 1 2 3)
-  "[ 1, 2, 3 ]")
+  "[ 1, 2, 3 ];")
 
 (test-ps-js array-literals-3
   (array (array 2 3)
        (array "foobar" "bratzel bub"))
-  "[ [ 2, 3 ], [ 'foobar', 'bratzel bub' ] ]")
+  "[ [ 2, 3 ], [ 'foobar', 'bratzel bub' ] ];")
 
 (test-ps-js array-literals-4
   (make-array)
-  "new Array()")
+  "new Array();")
 
 (test-ps-js array-literals-5
   (make-array 1 2 3)
-  "new Array(1, 2, 3)")
+  "new Array(1, 2, 3);")
 
 (test-ps-js array-literals-6
   (make-array
  (make-array 2 3)
  (make-array "foobar" "bratzel bub"))
-  "new Array(new Array(2, 3), new Array('foobar', 'bratzel bub'))")
+  "new Array(new Array(2, 3), new Array('foobar', 'bratzel bub'));")
 
 (test-ps-js object-literals-1
   (create :foo "bar" :blorg 1)
-  "{ foo : 'bar',
-  blorg : 1 }")
+  "{ foo : 'bar', blorg : 1 };")
 
 (test-ps-js object-literals-2
   (create :foo "hihi"
         :another-object (create :schtrunz 1))
   "{ foo : 'hihi',
   blorg : [ 1, 2, 3 ],
-  anotherObject : { schtrunz : 1 } }")
+  anotherObject : { schtrunz : 1 } };")
 
 (test-ps-js object-literals-3
   (slot-value an-object 'foo)
-  "anObject.foo")
+  "anObject.foo;")
 
 (test-ps-js object-literals-4
-  an-object.foo
-  "anObject.foo")
+  (@ an-object foo bar)
+  "anObject.foo.bar;")
 
 (test-ps-js object-literals-5
   (with-slots (a b c) this
 
 (test-ps-js regular-expression-literals-1
   (regex "foobar")
-  "/foobar/")
+  "/foobar/;")
 
 (test-ps-js regular-expression-literals-2
   (regex "/foobar/i")
-  "/foobar/i")
+  "/foobar/i;")
 
 (test-ps-js literal-symbols-1
   T
-  "true")
+  "true;")
 
 (test-ps-js literal-symbols-2
   FALSE
-  "false")
+  "false;")
 
 (test-ps-js literal-symbols-3
-  NIL
-  "null")
+  F
+  "false;")
 
 (test-ps-js literal-symbols-4
-  UNDEFINED
-  "undefined")
+  NIL
+  "null;")
 
 (test-ps-js literal-symbols-5
+  UNDEFINED
+  "undefined;")
+
+(test-ps-js literal-symbols-6
   THIS
-  "this")
+  "this;")
 
 (test-ps-js variables-1
   variable
-  "variable")
+  "variable;")
 
 (test-ps-js variables-2
   a-variable
-  "aVariable")
+  "aVariable;")
 
 (test-ps-js variables-3
   *math
-  "Math")
-
-(test-ps-js variables-4
-  *math.floor
-  "Math.floor")
+  "Math;")
 
 (test-ps-js function-calls-and-method-calls-1
   (blorg 1 2)
-  "blorg(1, 2)")
+  "blorg(1, 2);")
 
 (test-ps-js function-calls-and-method-calls-2
   (foobar (blorg 1 2) (blabla 3 4) (array 2 3 4))
-  "foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ])")
+  "foobar(blorg(1, 2), blabla(3, 4), [ 2, 3, 4 ]);")
 
 (test-ps-js function-calls-and-method-calls-3
-  ((aref foo i) 1 2)
-  "foo[i](1, 2)")
+  ((slot-value this 'blorg) 1 2)
+  "this.blorg(1, 2);")
 
 (test-ps-js function-calls-and-method-calls-4
-  (.blorg this 1 2)
-  "this.blorg(1, 2)")
+  ((aref foo i) 1 2)
+  "foo[i](1, 2);")
 
 (test-ps-js function-calls-and-method-calls-5
-  (this.blorg 1 2)
-  "this.blorg(1, 2)")
-
-(test-ps-js function-calls-and-method-calls-6
-  (.blorg (aref foobar 1) NIL T)
-  "foobar[1].blorg(null, true)")
+  ((slot-value (aref foobar 1) 'blorg) NIL T)
+  "foobar[1].blorg(null, true);")
 
 (test-ps-js operator-expressions-1
   (* 1 2)
-  "1 * 2")
+  "1 * 2;")
 
 (test-ps-js operator-expressions-2
   (= 1 2)
-  "1 == 2")
+  "1 == 2;")
 
 (test-ps-js operator-expressions-3
   (eql 1 2)
-  "1 == 2")
+  "1 == 2;")
 
-(test-ps-js operator-expressions-5
+(test-ps-js operator-expressions-4
   (* 1 (+ 2 3 4) 4 (/ 6 7))
-  "1 * (2 + 3 + 4) * 4 * (6 / 7)")
+  "1 * (2 + 3 + 4) * 4 * (6 / 7);")
 
-(test-ps-js operator-expressions-6
+(test-ps-js operator-expressions-5
   (incf i)
-  "++i")
+  "++i;")
 
-(test-ps-js operator-expressions-7
+(test-ps-js operator-expressions-6
   (decf i)
-  "--i")
+  "--i;")
 
-(test-ps-js operator-expressions-8
+(test-ps-js operator-expressions-7
   (1- i)
-  "i - 1")
+  "i - 1;")
 
-(test-ps-js operator-expressions-9
+(test-ps-js operator-expressions-8
   (1+ i)
-  "i + 1")
+  "i + 1;")
 
-(test-ps-js operator-expressions-10
+(test-ps-js operator-expressions-9
   (not (< i 2))
-  "i >= 2")
+  "i >= 2;")
 
-(test-ps-js operator-expressions-11
+(test-ps-js operator-expressions-10
   (not (eql i 2))
-  "i != 2")
+  "i != 2;")
 
 (test-ps-js body-forms-1
   (progn (blorg i) (blafoo i))
@@ -227,20 +222,20 @@ blafoo(i);")
 
 (test-ps-js body-forms-2
   (+ i (progn (blorg i) (blafoo i)))
-  "i + (blorg(i), blafoo(i))")
+  "i + (blorg(i), blafoo(i));")
 
 (test-ps-js function-definition-1
   (defun a-function (a b)
   (return (+ a b)))
   "function aFunction(a, b) {
-  return a + b;
-}")
+    return a + b;
+};")
 
 (test-ps-js function-definition-2
   (lambda (a b) (return (+ a b)))
   "function (a, b) {
-  return a + b;
-}")
+    return a + b;
+};")
 
 (test-ps-js assignment-1
   (setf a 1)
@@ -254,144 +249,235 @@ c = 4;
 x = a + b + c;")
 
 (test-ps-js assignment-3
-  (setf a (1+ a))
-  "a++;")
-
-(test-ps-js assignment-4
   (setf a (+ a 2 3 4 a))
   "a += 2 + 3 + 4 + a;")
 
-(test-ps-js assignment-5
+(test-ps-js assignment-4
   (setf a (- 1 a))
   "a = 1 - a;")
 
+(test-ps-js assignment-5
+  (let ((a 1) (b 2))
+  (psetf a b b a))
+  "var a1 = 1;
+var b2 = 2;
+var _js3_5 = b2;
+var _js4_6 = a1;
+a1 = _js3_5;
+b2 = _js4_6;")
+
+(test-ps-js assignment-6
+  (setq a 1)
+  "a = 1;")
+
+(test-ps-js assignment-8
+  (defun (setf color) (new-color el)
+  (setf (slot-value (slot-value el 'style) 'color) new-color))
+  "function __setf_color(newColor, el) {
+    el.style.color = newColor;
+};")
+
+(test-ps-js assignment-9
+  (setf (color some-div) (+ 23 "em"))
+  "var _js2_3 = someDiv;
+var _js1_4 = 23 + 'em';
+__setf_color(_js1_4, _js2_3);")
+
+(test-ps-js assignment-10
+  (defsetf left (el) (offset)
+  `(setf (slot-value (slot-value ,el 'style) 'left) ,offset))
+  "null;")
+
+(test-ps-js assignment-11
+  (setf (left some-div) (+ 123 "px"))
+  "var _js2_3 = someDiv;
+var _js1_4 = 123 + 'px';
+_js2_3.style.left = _js1_4;")
+
+(test-ps-js assignment-12
+  (macrolet ((left (el)
+             `(slot-value ,el 'offset-left)))
+  (left some-div))
+  "someDiv.offsetLeft;")
+
 (test-ps-js single-argument-statements-1
   (return 1)
-  "return 1")
+  "return 1;")
 
 (test-ps-js single-argument-statements-2
   (throw "foobar")
-  "throw 'foobar'")
+  "throw 'foobar';")
 
 (test-ps-js single-argument-expression-1
   (delete (new (*foobar 2 3 4)))
-  "delete new Foobar(2, 3, 4)")
+  "delete new Foobar(2, 3, 4);")
 
 (test-ps-js single-argument-expression-2
   (if (= (typeof blorg) *string)
     (alert (+ "blorg is a string: " blorg))
     (alert "blorg is not a string"))
   "if (typeof blorg == String) {
-  alert('blorg is a string: ' + blorg);
+    alert('blorg is a string: ' + blorg);
 } else {
-  alert('blorg is not a string');
-}")
+    alert('blorg is not a string');
+};")
 
 (test-ps-js conditional-statements-1
-  (if (blorg.is-correct)
+  (if ((@ blorg is-correct))
     (progn (carry-on) (return i))
     (alert "blorg is not correct!"))
   "if (blorg.isCorrect()) {
-  carryOn();
-  return i;
+    carryOn();
+    return i;
 } else {
-  alert('blorg is not correct!');
-}")
+    alert('blorg is not correct!');
+};")
 
 (test-ps-js conditional-statements-2
-  (+ i (if (blorg.add-one) 1 2))
-  "i + (blorg.addOne() ? 1 : 2)")
+  (+ i (if ((@ blorg add-one)) 1 2))
+  "i + (blorg.addOne() ? 1 : 2);")
 
 (test-ps-js conditional-statements-3
-  (when (blorg.is-correct)
+  (when ((@ blorg is-correct))
   (carry-on)
   (return i))
   "if (blorg.isCorrect()) {
-  carryOn();
-  return i;
-}")
+    carryOn();
+    return i;
+};")
 
 (test-ps-js conditional-statements-4
-  (unless (blorg.is-correct)
+  (unless ((@ blorg is-correct))
   (alert "blorg is not correct!"))
   "if (!blorg.isCorrect()) {
-  alert('blorg is not correct!');
-}")
+    alert('blorg is not correct!');
+};")
 
 (test-ps-js variable-declaration-1
   (defvar *a* (array 1 2 3))
-  "var A = [ 1, 2, 3 ]")
+  "var A = [ 1, 2, 3 ];")
 
 (test-ps-js variable-declaration-2
-  (if (= i 1)
-    (progn (defvar blorg "hallo")
-           (alert blorg))
-    (progn (defvar blorg "blitzel")
-           (alert blorg)))
-  "if (i == 1) {
-  var blorg = 'hallo';
-  alert(blorg);
-} else {
-  var blorg = 'blitzel';
-  alert(blorg);
-}")
-
-(test-ps-js variable-declaration-3
-  (if (= i 1)
-    (let ((blorg "hallo"))
-      (alert blorg))
-    (let ((blorg "blitzel"))
-      (alert blorg)))
-  "if (i == 1) {
-  var blorg = 'hallo';
-  alert(blorg);
-} else {
-  var blorg = 'blitzel';
-  alert(blorg);
-}")
+  (progn 
+  (defvar *a* 4)
+  (let ((x 1)
+        (*a* 2))
+    (let* ((y (+ x 1))
+           (x (+ x y)))
+      (+ *a* x y))))
+  "var A = 4;
+var x1 = 1;
+var A2;
+try {
+    A2 = A;
+    A = 2;
+    var y3 = x1 + 1;
+    var x4 = x1 + y3;
+    A + x4 + y3;
+} finally {
+    A = A2;
+};")
 
 (test-ps-js iteration-constructs-1
-  (do ((i 0 (1+ i))
-     (l (aref blorg i) (aref blorg i)))
-    ((or (= i blorg.length)
-         (eql l "Fumitastic")))
-  (document.write (+ "L is " l)))
-  "for (var i = 0, l = blorg[i];
-     !(i == blorg.length || l == 'Fumitastic');
-     i = i + 1, l = blorg[i]) {
-  document.write('L is ' + l);
-}")
+  (do* ((a) b (c (array "a" "b" "c" "d" "e"))
+      (d 0 (1+ d))
+      (e (aref c d) (aref c d)))
+     ((or (= d (@ c length)) (eql e "x")))
+  (setf a d b e)
+  ((@ document write) (+ "a: " a " b: " b "<br/>")))
+  "for (var a = null, b = null, c = ['a', 'b', 'c', 'd', 'e'], d = 0, e = c[d]; !(d == c.length || e == 'x'); d += 1, e = c[d]) {
+    a = d;
+    b = e;
+    document.write('a: ' + a + ' b: ' + b + '<br/>');
+};")
 
 (test-ps-js iteration-constructs-2
-  (dotimes (i blorg.length)
-  (document.write (+ "L is " (aref blorg i))))
-  "for (var i = 0; i < blorg.length; i = i + 1) {
-  document.write('L is ' + blorg[i]);
-}")
+  (do ((i 0 (1+ i))
+     (s 0 (+ s i (1+ i))))
+    ((> i 10))
+  ((@ document write) (+ "i: " i " s: " s "<br/>")))
+  "var i1 = 0;
+var s2 = 0;
+for (; i1 <= 10; ) {
+    document.write('i: ' + i1 + ' s: ' + s2 + '<br/>');
+    var _js3_5 = i1 + 1;
+    var _js4_6 = s2 + i1 + (i1 + 1);
+    i1 = _js3_5;
+    s2 = _js4_6;
+};")
 
 (test-ps-js iteration-constructs-3
-  (dolist (l blorg)
-  (document.write (+ "L is " l)))
-  "  var tmpArr1 = blorg;
-  for (var tmpI2 = 0; tmpI2 < tmpArr1.length;
-    tmpI2 = tmpI2 + 1) {
-    var l = tmpArr1[tmpI2];
-    document.write('L is ' + l);
-  };")
+  (do* ((i 0 (1+ i))
+      (s 0 (+ s i (1- i))))
+     ((> i 10))
+  ((@ document write) (+ "i: " i " s: " s "<br/>")))
+  "for (var i = 0, s = 0; i <= 10; i += 1, s += i + (i - 1)) {
+    document.write('i: ' + i + ' s: ' + s + '<br/>');
+};")
 
 (test-ps-js iteration-constructs-4
-  (doeach (i object)
-   (document.write (+ i " is " (aref object i))))
-  "for (var i in object) {
-  document.write(i + ' is ' + object[i]);
-}")
+  (let ((arr (array "a" "b" "c" "d" "e")))
+  (dotimes (i (@ arr length))
+    ((@ document write) (+ "i: " i " arr[i]: " (aref arr i) "<br/>"))))
+  "var arr1 = ['a', 'b', 'c', 'd', 'e'];
+for (var i = 0; i < arr1.length; i += 1) {
+    document.write('i: ' + i + ' arr[i]: ' + arr1[i] + '<br/>');
+};")
 
 (test-ps-js iteration-constructs-5
-  (while (film.is-not-finished)
-  (this.eat (new *popcorn)))
+  (let ((res 0))
+  (alert (+ "Summation to 10 is "
+            (dotimes (i 10 res)
+              (incf res (1+ i))))))
+  "var res1 = 0;
+alert('Summation to 10 is ' + (function () {
+    for (var i = 0; i < 10; i += 1) {
+        res1 += i + 1;
+    };
+    return res1;
+})());")
+
+(test-ps-js iteration-constructs-6
+  (let ((l (list 1 2 4 8 16 32)))
+  (dolist (c l)
+    ((@ document write) (+ "c: " c "<br/>"))))
+  "var l1 = [1, 2, 4, 8, 16, 32];
+for (var c = null, _js_arrvar3 = l1, _js_idx2 = 0; _js_idx2 < _js_arrvar3.length; _js_idx2 += 1) {
+    c = _js_arrvar3[_js_idx2];
+    document.write('c: ' + c + '<br/>');
+};")
+
+(test-ps-js iteration-constructs-7
+  (let ((l '(1 2 4 8 16 32))
+      (s 0))
+  (alert (+ "Sum of " l " is: "
+            (dolist (c l s)
+              (incf s c)))))
+  "var l1 = [1, 2, 4, 8, 16, 32];
+var s2 = 0;
+alert('Sum of ' + l1 + ' is: ' + (function () {
+    for (var c = null, _js_arrvar4 = l1, _js_idx3 = 0; _js_idx3 < _js_arrvar4.length; _js_idx3 += 1) {
+        c = _js_arrvar4[_js_idx3];
+        s2 += c;
+    };
+    return s2;
+})());")
+
+(test-ps-js iteration-constructs-8
+  (let ((obj (create :a 1 :b 2 :c 3)))
+  (for-in (i obj)
+    ((@ document write) (+ i ": " (aref obj i) "<br/>"))))
+  "var obj1 = { a : 1, b : 2, c : 3 };
+for (var i in obj1) {
+    document.write(i + ': ' + obj1[i] + '<br/>');
+};")
+
+(test-ps-js iteration-constructs-9
+  (while ((@ film is-not-finished))
+  ((@ this eat) (new *popcorn)))
   "while (film.isNotFinished()) {
-  this.eat(new Popcorn);
-}")
+    this.eat(new Popcorn);
+};")
 
 (test-ps-js the-case-statement-1
   (case (aref blorg i)
@@ -399,15 +485,16 @@ x = a + b + c;")
   (2 (alert "two"))
   (t (alert "default clause")))
   "switch (blorg[i]) {
-  case 1:   
-  case 'one':
-            alert('one');
-            break;
-  case 2:
-            alert('two');
-            break;
-  default:   alert('default clause');
-}")
+    case 1:
+    case 'one':
+        alert('one');
+        break;
+    case 2:
+        alert('two');
+        break;
+    default: 
+        alert('default clause');
+    };")
 
 (test-ps-js the-case-statement-2
   (switch (aref blorg i)
@@ -415,18 +502,17 @@ x = a + b + c;")
   (2 (alert "I also get here"))
   (default (alert "I always get here")))
   "switch (blorg[i]) {
-  case 1:   alert('If I get here');
-  case 2:   alert('I also get here');
-  default:   alert('I always get here');
-}")
+    case 1: alert('If I get here');
+    case 2: alert('I also get here');
+    default: alert('I always get here');
+};")
 
 (test-ps-js the-with-statement-1
   (with (create :foo "foo" :i "i")
   (alert (+ "i is now intermediary scoped: " i)))
-  "with ({ foo : 'foo',
-        i : 'i' }) {
-  alert('i is now intermediary scoped: ' + i);
-}")
+  "with ({ foo : 'foo', i : 'i' }) {
+    alert('i is now intermediary scoped: ' + i);
+};")
 
 (test-ps-js the-try-statement-1
   (try (throw "i")
@@ -435,51 +521,37 @@ x = a + b + c;")
  (:finally
    (alert "Leaving the try form")))
   "try {
-  throw 'i';
+    throw 'i';
 } catch (error) {
-  alert('an error happened: ' + error);
+    alert('an error happened: ' + error);
 } finally {
-  alert('Leaving the try form');
-}")
+    alert('Leaving the try form');
+};")
 
 (test-ps-js the-html-generator-1
-  (html ((:a :href "foobar") "blorg"))
-  "'<a href=\"foobar\">blorg</a>'")
+  (ps-html ((:a :href "foobar") "blorg"))
+  "'<A HREF=\"foobar\">blorg</A>';")
 
 (test-ps-js the-html-generator-2
-  (html ((:a :href (generate-a-link)) "blorg"))
-  "'<a href=\"' + generateALink() + '\">blorg</a>'")
+  (ps-html ((:a :href (generate-a-link)) "blorg"))
+  "'<A HREF=\"' + generateALink() + '\">blorg</A>';")
 
 (test-ps-js the-html-generator-3
-  (document.write
-  (html ((:a :href "#"
-            :onclick (ps-inline (transport))) "link")))
-  "document.write('<a href=\"#\" onclick=\"' + 'javascript:transport();' + '\">link</a>')")
+  ((@ document write)
+  (ps-html ((:a :href "#"
+                :onclick (ps-inline (transport))) "link")))
+  "document.write('<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport' + '(' + ')') + '\">link</A>');")
 
 (test-ps-js the-html-generator-4
   (let ((disabled nil)
       (authorized t))
-   (setf element.inner-h-t-m-l
-         (html ((:textarea (or disabled (not authorized)) :disabled "disabled")
+   (setf (@ element inner-h-t-m-l)
+         (ps-html ((:textarea (or disabled (not authorized)) :disabled "disabled")
                 "Edit me"))))
-  "   var disabled = null;
-   var authorized = true;
-   element.innerHTML =
-   '<textarea'
-   + (disabled || !authorized ? ' disabled=\"' + 'disabled' + '\"' : '')
-   + '>Edit me</textarea>';")
-
-(test-ps-js the-html-generator-5
-  (css-inline :color "red"
-            :font-size "x-small")
-  "'color:red;font-size:x-small'")
-
-(test-ps-js the-html-generator-6
-  (defun make-color-div(color-name)
-    (return (html ((:div :style (css-inline :color color-name))
-                   color-name " looks like this."))))
-  "function makeColorDiv(colorName) {
-  return '<div style=\"' + ('color:' + colorName) + '\">' + colorName
-    + ' looks like this.</div>';
-}")
+  "var disabled1 = null;
+var authorized2 = true;
+element.innerHTML =
+'<TEXTAREA'
++ (disabled1 || !authorized2 ? ' DISABLED=\"' + 'disabled' + '\"' : '')
++ '>Edit me</TEXTAREA>';")