3 ;;; Hand-written unit tests
5 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
9 (test-ps-js plus-is-not-commutative
10 (setf x
(+ "before" x
"after"))
11 "x = 'before' + x + 'after';")
13 (test-ps-js plus-works-if-first
14 (setf x
(+ x
"middle" "after"))
15 "x += 'middle' + 'after';")
17 (test-ps-js setf-side-effects
23 (setf x
(+ 2 (side-effect) x
5))))
25 function sideEffect() {
29 x = 2 + sideEffect() + x + 5;")
30 ;; Parenscript used to optimize incorrectly:
32 ;; function sideEffect() {
36 ;; x += 2 + sideEffect() + 5;
38 ;; Which is 20, not 14
41 (test-ps-js method-call-op-form
42 ((@ (+ "" x
) to-string
))
43 "('' + x).toString();")
45 (test-ps-js method-call-op-form-args
46 ((@ (+ "" x
) to-string
) 1 2 :baz
3)
47 "('' + x).toString(1, 2, 'baz', 3);")
49 (test-ps-js method-call-number
53 (test-ps-js method-call-string
57 (test-ps-js method-call-lit-object
58 ((@ (create to-string
(lambda () (return "it works"))) to-string
))
59 "( { toString : function () { return 'it works'; } } ).toString();")
61 (test-ps-js method-call-conditional
65 (test-ps-js method-call-variable
69 (test-ps-js method-call-array
70 ((@ (list 10 20) to-string
))
71 "[ 10, 20 ].toString();")
73 (test-ps-js method-call-fn-call
77 (test-ps-js method-call-lambda-fn
78 ((@ (lambda () (alert 10)) to-string
))
79 "( function () { alert(10); } ).toString();")
81 (test-ps-js method-call-lambda-call
82 ((@ ((lambda (x) (return x
)) 10) to-string
))
83 "(function (x) { return x; })(10).toString();")
85 (test no-whitespace-before-dot
86 (let* ((str (ps* '((@ ((lambda (x) (return x
)) 10) to-string
))))
87 (dot-pos (position #\. str
:test
#'char
=))
88 (char-before (elt str
(1- dot-pos
)))
90 (is (char= char-before a-parenthesis
))))
92 (test-ps-js simple-slot-value
93 (let ((foo (create a
1)))
94 (alert (slot-value foo
'a
)))
98 (test-ps-js buggy-slot-value
99 (let ((foo (create a
1))
101 (alert (slot-value foo slot-name
)))
102 " var foo = { a : 1 };
104 alert(foo[slotName]);
105 "); Last line was alert(foo.slotName) before bug-fix.
107 (test-ps-js buggy-slot-value-two
108 (slot-value foo
(get-slot-name))
109 "foo[getSlotName()];")
111 (test-ps-js old-case-is-now-switch
112 ;; Switch was "case" before, but that was very non-lispish.
113 ;; For example, this code makes three messages and not one
114 ;; which may have been expected. This is because a switch
115 ;; statment must have a break statement for it to return
116 ;; after the alert. Otherwise it continues on the next
118 (switch (aref blorg i
)
121 (default (alert "default clause")))
123 case 1: alert('one');
124 case 2: alert('two');
125 default: alert('default clause');
128 (test-ps-js lisp-like-case
132 (default (alert "default clause")))
140 default: alert('default clause');
144 (test-ps-js even-lispier-case
146 ((1 2) (alert "Below three"))
148 (t (alert "Something else")))
152 alert('Below three');
157 default: alert('Something else');
160 (test-ps-js otherwise-case
163 (otherwise (alert "default clause")))
168 default: alert('default clause');
171 (test escape-sequences-in-string
172 (let ((escapes `((#\\ .
#\\)
174 (#\f .
,(code-char 12))
175 ("u000B" .
,(code-char #x000b
));;Vertical tab, too uncommon to bother with
178 (#\' .
#\');;Double quote need not be quoted because parenscript strings are single quoted
180 ("u001F" .
,(code-char #x001f
));; character below 32
181 ("u0080" .
,(code-char 128)) ;;Character over 127. Actually valid, parenscript escapes them to be sure.
182 ("uABCD" .
,(code-char #xabcd
)))));; Really above ascii.
183 (loop for
(js-escape . lisp-char
) in escapes
184 for generated
= (ps-doc* `(let ((x ,(format nil
"hello~ahi" lisp-char
)))))
185 for wanted
= (format nil
"var x = 'hello\\~ahi';" js-escape
)
186 do
(is (string= (normalize-js-code generated
) wanted
)))))
188 (test-ps-js slot-value-setf
189 (setf (slot-value x
'y
) (+ (+ a
3) 4))
190 "x.y = (a + 3) + 4;")
192 (test-ps-js slot-value-conditional1
193 (slot-value (if zoo foo bar
) 'x
)
194 "(zoo ? foo : bar).x;")
196 (test-ps-js slot-value-conditional2
197 (slot-value (if (not zoo
) foo bar
) 'x
)
198 "(!zoo ? foo : bar).x;")
200 (test script-star-eval1
201 (is (string= "x = 1; y = 2;" (normalize-js-code (ps* '(setf x
1) '(setf y
2))))))
203 (test script-star-eval2
204 (is (string= "x = 1;" (normalize-js-code (ps* '(setf x
1))))))
206 (test-ps-js unquoted-nil
210 (test-ps-js list-with-single-nil
214 (test-ps-js quoted-nil-is-array
219 (progn (defsetf baz
(x y
) (newval) `(set-baz ,x
,y
,newval
))
224 setBaz(_js2, _js3, _js1);")
226 (test-ps-js setf-macroexpands1
227 (macrolet ((baz (x y
) `(aref ,x
,y
1)))
228 (setf (baz foo
2) 3))
231 (test-ps-js defsetf-short
232 (progn (defsetf baz set-baz
"docstring")
233 (setf (baz 1 2 3) "foo"))
234 "setBaz(1, 2, 3, 'foo');")
236 (test-ps-js defun-setf1
237 (progn (defun (setf some-thing
) (new-val i1 i2
)
238 (setf (aref *some-thing
* i1 i2
) new-val
))
239 (setf (some-thing 1 2) "foo"))
240 "function __setf_someThing(newVal, i1, i2) {
241 SOMETHING[i1][i2] = newVal;
246 __setf_someThing(_js1, _js2, _js3);")
248 (test-ps-js defun-optional1
249 (defun test-opt (&optional x
) (return (if x
"yes" "no")))
250 "function testOpt(x) {
251 if (x === undefined) {
254 return x ? 'yes' : 'no';
257 (test-ps-js defun-optional2
258 (defun foo (x &optional y
) (+ x y
))
259 "function foo(x, y) {
260 if (y === undefined) {
266 (test-ps-js defun-optional3
267 (defun blah (&optional
(x 0))
270 if (x === undefined) {
276 (test-ps-js return-nothing
280 (test-ps-js set-timeout
281 (do-set-timeout (10) (alert "foo"))
282 "setTimeout(function () { alert('foo'); }, 10);")
284 (test-ps-js operator-precedence
288 (test-ps-js operators-1
308 (test-ps-js setf-conditional
309 (setf foo
(if x
1 2))
312 (test-ps-js obj-literal-numbers
316 (test-ps-js obj-literal-strings
320 (test-ps-js slot-value-string
321 (slot-value foo
"bar")
324 (test-ps-js slot-value-string1
325 (slot-value "bar" 'length
)
328 (test-ps-js slot-value-progn
329 (slot-value (progn (some-fun "abc") "123") "length")
330 "(someFun('abc'), '123')['length'];")
332 (test-ps-js method-call-block
333 ((@ (progn (some-fun "abc") "123") to-string
))
334 "(someFun('abc'), '123').toString();")
336 (test-ps-js create-blank
340 (test-ps-js blank-object-literal
344 (test-ps-js array-literal1
348 (test-ps-js array-literal2
352 (test-ps-js array-literal3
356 (test-ps-js array-literal4
360 (test-ps-js array-literal5
362 "[[1, 2], ['a', 'b']];")
364 (test-ps-js defun-rest1
365 (defun foo (&rest bar
) (alert (aref bar
1)))
368 for (var i1 = 0; i1 < arguments.length - 0; i1 += 1) {
369 bar[i1] = arguments[i1 + 0];
374 (test-ps-js defun-rest2
375 (defun foo (baz &rest bar
) (return (+ baz
(aref bar
1))))
378 for (var i1 = 0; i1 < arguments.length - 1; i1 += 1) {
379 bar[i1] = arguments[i1 + 1];
384 (test-ps-js defun-keyword1
385 (defun zoo (foo bar
&key baz
) (return (+ foo bar baz
)))
386 "function zoo(foo, bar) {
388 var _js2 = arguments.length;
389 for (var n1 = 2; n1 < _js2; n1 += 2) {
390 switch (arguments[n1]) {
393 baz = arguments[n1 + 1];
397 if (baz === undefined) {
400 return foo + bar + baz;
403 (test-ps-js defun-keyword2
404 (defun zoo (&key baz
) (return (* baz baz
)))
407 var _js2 = arguments.length;
408 for (var n1 = 0; n1 < _js2; n1 += 2) {
409 switch (arguments[n1]) {
412 baz = arguments[n1 + 1];
416 if (baz === undefined) {
422 (test-ps-js defun-keyword3
423 (defun zoo (&key baz
(bar 4)) (return (* baz bar
)))
427 var _js2 = arguments.length;
428 for (var n1 = 0; n1 < _js2; n1 += 2) {
429 switch (arguments[n1]) {
432 baz = arguments[n1 + 1];
437 bar = arguments[n1 + 1];
441 if (baz === undefined) {
444 if (bar === undefined) {
450 (test-ps-js defun-keyword4
451 (defun hello-world (&key
((:my-name-key my-name
) 1))
453 "function helloWorld() {
455 var _js2 = arguments.length;
456 for (var n1 = 0; n1 < _js2; n1 += 2) {
457 switch (arguments[n1]) {
460 myName = arguments[n1 + 1];
464 if (myName === undefined) {
470 (test-ps-js keyword-funcall1
474 (test-ps-js keyword-funcall2
475 (func :baz
1 :bar foo
)
476 "func('baz', 1, 'bar', foo);")
478 (test-ps-js keyword-funcall3
480 "fun(a, b, 'baz', c);")
490 ((= y
(* x
4)) (foo "blah") (* x y
)))
493 } else if (y == x * 4) {
498 (test-ps-js if-exp-without-else-returns-null
500 "return x ? 1 : null;")
502 (test-ps-js progn-expression-single-statement
503 (return (progn (* x y
)))
506 (test-ps-js cond-expression1
507 (defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)))))
509 return 1 < 2 ? (bar('foo'), 4 * 5) : null;
512 (test-ps-js cond-expression2
513 (defun foo () (return (cond ((< 2 1) "foo") ((= 7 7) "bar"))))
515 return 2 < 1 ? 'foo' : (7 == 7 ? 'bar' : null);
518 (test-ps-js cond-expression-final-t-clause
520 (return (cond ((< 1 2) (bar "foo") (* 4 5))
528 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'));
531 (test-ps-js cond-expression-middle-t-clause
;; should this signal a warning?
532 (defun foo () (return (cond ((< 2 1) 5) (t "foo") ((< 1 2) "bar"))))
534 return 2 < 1 ? 5 : 'foo';
537 (test-ps-js funcall-if-expression
539 (if (= *linkornot
* 1)
540 (ps-html ((:a
:href
"#"
541 :onclick
(ps-inline (transport)))
544 "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport()') + '\">' + img + '</A>' : img);")
546 (test-ps-js negate-number-literal
;; ok, this was broken and fixed before, but no one bothered to add the test!
550 (test macro-environment1
551 (is (string= (normalize-js-code (let* ((macroname (gensym)))
552 (ps* `(defmacro ,macroname
(x) `(+ ,x
123))
554 (macrolet ((,macroname
(x) `(aref data
,x
)))
556 (setf (,macroname x
) 123)))))))
565 (test macro-environment2
566 (is (string= (normalize-js-code (let ((outer-lexical-variable 1))
567 (defpsmacro macro-environment2-macro
(x)
568 `(+ ,outer-lexical-variable
,x
))
569 (ps* '(macro-environment2-macro 2))))
570 (normalize-js-code "1 + 2;"))))
572 (test-ps-js ampersand-whole-1
573 (macrolet ((foo (&whole foo bar baz
)
574 (declare (ignore bar baz
))
575 (format nil
"~a" foo
)))
579 (test-ps-js keyword-consistent
583 (test-ps-js simple-symbol-macrolet
584 (symbol-macrolet ((x 1)) x
)
587 (test-ps-js compound-symbol-macrolet
588 (symbol-macrolet ((x 123)
593 (test-ps-js define-symbol-macro
594 (progn (define-symbol-macro tst-sym-macro
2)
598 (test-ps-js expression-progn
599 (defun f () (return (progn (foo) (if x
1 2))))
601 return (foo(), x ? 1 : 2);
604 (test-ps-js let-decl-in-expression
612 return x ? 1 : (foo = x, foo);
615 (test-ps-js special-var1
616 (progn (defvar *foo
*)
629 (test-ps-js special-var2
630 (progn (defvar *foo
*)
653 (test-ps-js setf-dec1
657 (test-ps-js setf-dec2
661 (test-ps-js special-char-equals
665 (test-ps-js setf-operator-priority
666 (return (or (slot-value cache id
)
667 (setf (slot-value cache id
) ((@ document get-element-by-id
) id
))))
668 "return cache[id] || (cache[id] = document.getElementById(id));")
670 (test-ps-js aref-operator-priority
671 (aref (if (and x
(> (length x
) 0))
675 "(x && x.length > 0 ? x[0] : y)[z];")
677 (test-ps-js aref-operator-priority1
678 (aref (or (slot-value x
'y
)
683 (test-ps-js aref-operator-priority2
687 (test-ps-js negative-operator-priority
696 (delete (if a
(or b c
) d
))
697 "delete (a ? b || c : d);")
700 (not (if (or x
(not y
)) z
))
701 "!(x || !y ? z : null);")
708 (instanceof (or a b
) (if x y z
))
709 "((a || b) instanceof (x ? y : z));")
712 (or x
(if (= x
0) "zero" "empty"))
713 "x || (x == 0 ? 'zero' : 'empty');")
715 (test-ps-js named-op-expression
719 (test-ps-js named-op-expression1
723 (test-ps-js aref-array-expression
727 (test-ps-js slot-value-operator
728 (slot-value (or a b c
) 'd
)
731 (test-ps-js slot-value-parens
732 (slot-value (slot-value foo
'bar
) 'baz
)
735 (test-ps-js funcall-funcall
739 (test-ps-js expression-funcall
740 ((or (@ window eval
) eval
) foo nil
)
741 "(window.eval || eval)(foo, null);")
743 (test-ps-js expression-funcall1
744 (((or (@ window eval
) eval
) foo nil
))
745 "(window.eval || eval)(foo, null)();")
747 (test-ps-js expression-funcall2
748 (((or (@ window eval
) eval
)) foo nil
)
749 "(window.eval || eval)()(foo, null);")
751 (test-ps-js slot-value-object-literal
752 (slot-value (create a
1) 'a
)
755 (test-ps-js slot-value-lambda
756 (slot-value (lambda ()) 'prototype
)
757 "(function () { }).prototype;")
759 (test-ps-js who-html1
760 (who-ps-html (:span
:class
"ticker-symbol"
761 :ticker-symbol symbol
762 (:a
:href
"http://foo.com"
764 (:span
:class
"ticker-symbol-popup")))
765 "'<SPAN CLASS=\"ticker-symbol\" TICKER-SYMBOL=\"' + symbol + '\"><A HREF=\"http://foo.com\">' + symbol + '</A><SPAN CLASS=\"ticker-symbol-popup\"></SPAN></SPAN>';")
768 ((lambda () (flet ((foo (x)
772 var foo1 = function (x) {
779 (flet ((foo (x) (return (1+ x
)))
780 (bar (y) (return (+ 2 y
))))
782 "var foo1 = function (x) {
785 var bar2 = function (y) {
791 (flet ((foo (x) (return (1+ x
)))
792 (bar (y) (return (+ 2 (foo y
)))))
794 "var foo1 = function (x) {
797 var bar2 = function (y) {
803 ((lambda () (labels ((foo (x)
804 (return (if (=== 0 x
)
806 (+ x
(foo (1- x
)))))))
809 var foo1 = function (x) {
810 return 0 === x ? 0 : x + foo1(x - 1);
816 (labels ((foo (x) (return (1+ (bar x
))))
817 (bar (y) (return (+ 2 (foo y
)))))
819 "var foo1 = function (x) {
822 var bar2 = function (y) {
828 (labels ((foo (x) (return (1+ x
)))
829 (bar (y) (return (+ 2 (foo y
)))))
831 "var foo1 = function (x) {
834 var bar2 = function (y) {
839 (test-ps-js for-loop-var-init-exp
841 (return (do* ((y (if x
0 1) (1+ y
))
846 return (function () {
847 for (var y = x ? 0 : 1, z = 0; y != 3; y += 1, z += 1) {
857 (test-ps-js literal-array
861 (test-ps-js literal-array-1
865 (test ps-lisp-expands-in-lexical-environment
866 (is (string= "5;" (let ((x 5)) (ps (lisp x
))))))
868 (test ps
*-lisp-expands-in-null-lexical-environment
869 (signals error
(let ((x 5)) (declare (ignore x
)) (ps* '(lisp x
)))))
871 (test ps
*-lisp-expands-in-dynamic-environment
872 (is (string= "1 + 2;" (let ((*print-level
* 2)) (ps* '(+ 1 (lisp *print-level
*)))))))
874 (test ps-lisp-dynamic-environment
875 (is (string= "1 + 2;" (let ((*print-level
* 2)) (ps (+ 1 (lisp *print-level
*)))))))
877 (test-ps-js ps-js-target-version-keyword-test1
878 (defun foo (x y
&key bar baz
))
879 "function foo(x, y) {
880 var x1 = Array.prototype.indexOf.call(arguments, 'bar', 2);
881 var bar = -1 == x1 ? null : arguments[x1 + 1];
882 var x2 = Array.prototype.indexOf.call(arguments, 'baz', 2);
883 var baz = -1 == x2 ? null : arguments[x2 + 1];
885 :js-target-version
1.6)
887 (test-ps-js nested-if-expressions1
888 (return (if (if x y z
) a b
))
889 "return (x ? y : z) ? a : b;")
891 (test-ps-js nested-if-expressions2
892 (return (if x y
(if z a b
)))
893 "return x ? y : (z ? a : b);")
953 (return (let (x) (+ x x
))))
956 return (x = null, x + x);
960 (let* ((x 1)) (+ x x
))
992 (test-ps-js symbol-macrolet-var
993 (symbol-macrolet ((x y
))
997 (test-ps-js setf-conditional1
998 (setf x
(unless (null a
) (1+ a
)))
999 "x = a != null ? a + 1 : null;")
1001 (test-ps-js setf-let1
1002 (setf x
(let ((a 1)) a
))
1005 (test-ps-js setf-let2
1006 (setf x
(let ((a (foo)))
1009 "x = (a = foo(), a != null ? a + 1 : null);")
1011 (test-ps-js symbol-macro-env1
1012 (symbol-macrolet ((bar 1))
1013 (macrolet ((bar (x y
) `(+ ,x
,y
)))
1017 (test-ps-js symbol-macrolet-fun1
1018 (symbol-macrolet ((baz +))
1022 (test-ps-js lisp2-namespaces1
1024 (setf list
(list 1 2 3)))
1028 (test-ps-js let-shadows-symbol-macrolet
1029 (symbol-macrolet ((x y
))
1037 (test-ps-js let-rename-optimization1
1043 (test-ps-js let-rename-optimization2
1052 (test-ps-js symbol-macro-array
1053 (symbol-macrolet ((x 1))
1057 (test-ps-js symbol-macro-obj
1058 (symbol-macrolet ((x y
))
1062 (test-ps-js symbol-macro-conditional1
1063 (symbol-macrolet ((x y
))
1071 (test-ps-js symbol-macro-conditional2
1072 (symbol-macrolet ((x y
))
1073 (return (if x x x
)))
1074 "return y ? y : y;")
1076 (test-ps-js flet-apply
1077 (flet ((foo () 'bar
))
1078 (apply (function foo
) nil
))
1079 "var foo1 = function () {
1082 foo1.apply(this, null);")
1084 (test-ps-js let-apply
1085 (let ((foo (lambda () (return 1))))
1086 (let ((foo (lambda () (return 2))))
1088 "var foo = function () {
1091 var foo1 = function () {
1094 foo1.apply(this, null);")
1096 (test-ps-js flet-let
1097 (flet ((x (x) (return (1+ x
))))
1100 "var x1 = function (x) {
1106 (test-ps-js let-flet
1108 (flet ((x (x) (return (1+ x
))))
1111 var x1 = function (x) {
1116 (test-ps-js macrolet-let-inteference
1117 (macrolet ((a (n) `(+ ,n
5)))
1119 (let ((b (a (- a
4))))
1122 var b = (a - 4) + 5;
1125 (test-ps-js let-subtract-add
1139 (test-ps-js create-reserved-word
1141 "{ 'default' : 1 };")
1143 (test-ps-js slot-value-reserved-word
1144 (slot-value foo
:default
)
1147 (test-ps-js eval-when-ps-side
1148 (eval-when (:execute
)
1152 (defvar *lisp-output
* nil
)
1154 (test eval-when-lisp-side
()
1155 (setf *lisp-output
* 'original-value
)
1156 (let ((js-output (normalize-js-code
1157 (ps-doc* `(eval-when (:compile-toplevel
)
1158 (setf *lisp-output
* 'it-works
))))))
1159 (is (eql 'it-works
*lisp-output
*))
1160 (is (string= "" js-output
))))
1162 (defpsmacro my-in-package
(package-name)
1163 `(eval-when (:compile-toplevel
)
1164 (setf *lisp-output
* ,package-name
)))
1166 (test eval-when-macro-expansion
()
1167 (setf *lisp-output
* 'original-value
)
1168 (let ((js-output (normalize-js-code
1170 (my-in-package :cl-user
)
1172 (declare (ignore js-output
))
1173 (is (eql :cl-user
*lisp-output
*))))
1175 (test eval-when-macrolet-expansion
()
1176 (setf *lisp-output
* 'original-value
)
1177 (let ((js-output (normalize-js-code
1178 (ps-doc* `(macrolet ((my-in-package2 (package-name)
1179 `(eval-when (:compile-toplevel
)
1180 (setf *lisp-output
* ,package-name
))))
1181 (my-in-package2 :cl-user
)
1183 (declare (ignore js-output
))
1184 (is (eql :cl-user
*lisp-output
*))))
1186 (test-ps-js slot-value-keyword
1187 (slot-value foo
:bar
)
1190 (test-ps-js nary-comparison1
1191 (lambda () (return (< 1 2 3)))
1194 return (_cmp1 = 2, 1 < _cmp1 && _cmp1 < 3);
1197 (test-ps-js chain-slot-value1
1198 (chain ($
"foo") (bar x z
) frob
(baz 5))
1199 "$('foo').bar(x, z).frob.baz(5);")
1201 (test-ps-js chain-slot-value2
1202 (chain ($
"foo") bar baz
)
1203 "$('foo').bar.baz;")
1205 (test-ps-js chain-slot-value3
1206 (chain ($
"foo") bar
(x y
) baz
)
1207 "$('foo').bar.x(y).baz;")