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 (ps1* '((@ ((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
= (ps1* `(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 complicated-symbol-name1
192 (test-ps-js complicated-symbol-name2
196 (test-ps-js slot-value-setf
197 (setf (slot-value x 'y) (+ (+ a 3) 4))
198 "x.y = (a + 3) + 4;")
200 (test-ps-js slot-value-conditional1
201 (slot-value (if zoo foo bar) 'x)
202 "(zoo ? foo : bar).x")
204 (test-ps-js slot-value-conditional2
205 (slot-value (if (not zoo) foo bar) 'x)
206 "(!zoo ? foo : bar).x")
208 (test script-star-eval1
209 (is (string= "x = 1; y = 2;" (normalize-js-code (ps* '(setf x 1) '(setf y 2))))))
211 (test script-star-eval2
212 (is (string= "x = 1;" (normalize-js-code (ps* '(setf x 1))))))
214 (test-ps-js slot-value-null1
218 (test-ps-js slot-value-null2
219 (slot-value foo 'nil)
222 (test-ps-js unquoted-nil
226 (test-ps-js list-with-single-nil
230 (test-ps-js quoted-nil
235 (ps (defsetf baz (x y) (newval) `(set-baz ,x ,y ,newval)))
236 (is (string= "var _js2 = 1; var _js3 = 2; var _js1 = 3; setBaz(_js2, _js3, _js1);"
237 (normalize-js-code (let* ((ps:*ps-gensym-counter* 0))
238 (ps (setf (baz 1 2) 3)))))))
241 (ps (defsetf baz set-baz "blah"))
242 (is (string= "setBaz(1, 2, 3, 'foo');" (normalize-js-code (ps (setf (baz 1 2 3) "foo"))))))
245 (is (and (string= (normalize-js-code (ps:ps (defun (setf some-thing) (new-val i1 i2)
246 (setf (aref *some-thing* i1 i2) new-val))))
247 "function __setf_someThing(newVal, i1, i2) { SOMETHING[i1][i2] = newVal; };")
248 (string= (normalize-js-code (ps:ps-doc (setf (some-thing 1 2) "foo")))
249 "var _js2 = 1; var _js3 = 2; var _js1 = 'foo'; __setf_someThing(_js1, _js2, _js3);"))))
251 (test-ps-js defun-optional1
252 (defun test-opt (&optional x) (return (if x "yes" "no")))
253 "function testOpt(x) {
254 if (x === undefined) {
257 return x ? 'yes' : 'no';
260 (test-ps-js defun-optional2
261 (defun foo (x &optional y) (+ x y))
262 "function foo(x, y) {
263 if (y === undefined) {
269 (test-ps-js defun-optional3
270 (defun blah (&optional (x 0))
273 if (x === undefined) {
279 (test-ps-js return-nothing
283 (test-ps-js set-timeout
284 (do-set-timeout (10) (alert "foo"))
285 "setTimeout(function () { alert('foo'); }, 10)")
286 (test-ps-js operator-precedence
290 (test-ps-js operators-1
310 (test-ps-js setf-conditional
311 (setf foo (if x 1 2))
314 (test-ps-js obj-literal-numbers
318 (test-ps-js obj-literal-strings
322 (test-ps-js slot-value-string
323 (slot-value foo "bar")
326 (test-ps-js slot-value-string1
327 (slot-value "bar" 'length)
330 (test-ps-js slot-value-progn
331 (slot-value (progn (some-fun "abc") "123") "length")
332 "(someFun('abc'), '123')['length']")
334 (test-ps-js method-call-block
335 ((@ (progn (some-fun "abc") "123") to-string))
336 "(someFun('abc'), '123').toString()")
338 (test-ps-js create-blank
342 (test-ps-js blank-object-literal
346 (test-ps-js array-literal1
350 (test-ps-js array-literal2
354 (test-ps-js array-literal3
358 (test-ps-js array-literal4
362 (test-ps-js array-literal5
364 "[[1, 2], ['a', 'b']]")
366 (test-ps-js defun-rest1
367 (defun foo (&rest bar) (alert bar[1]))
370 for (var i2 = 0; i2 < arguments.length - 0; i2 += 1) {
371 bar[i2] = arguments[i2 + 0];
376 (test-ps-js defun-rest2
377 (defun foo (baz &rest bar) (return (+ baz (aref bar 1))))
380 for (var i2 = 0; i2 < arguments.length - 1; i2 += 1) {
381 bar[i2] = arguments[i2 + 1];
386 (test-ps-js defun-keyword1
387 (defun zoo (foo bar &key baz) (return (+ foo bar baz)))
388 "function zoo(foo, bar, _js1) {
389 if (_js1 === undefined) {
392 return foo + bar + _js1.baz;
395 (test-ps-js defun-keyword2
396 (defun zoo (&key baz) (return (* baz baz)))
397 "function zoo(_js1) {
398 if (_js1 === undefined) {
401 return _js1.baz * _js1.baz;
404 (test-ps-js defun-keyword3
405 (defun zoo (&key baz (bar 4)) (return (* baz bar)))
406 "function zoo(_js1) {
407 if (_js1 === undefined) {
410 if (_js1.bar === undefined) {
413 return _js1.baz * _js1.bar;
416 (test-ps-js keyword-funcall1
420 (test-ps-js keyword-funcall2
421 (func :baz 1 :bar foo)
422 "func({ baz : 1, bar : foo })")
424 (test-ps-js keyword-funcall3
426 "fun(a, b, { baz : c })")
435 (cond ((= x 1) 2) ((= y (* x 4)) (foo "blah") (* x y)))
438 } else if (y == x * 4) {
443 (test-ps-js if-exp-without-else-returns-null
445 "return x ? 1 : null")
447 (test-ps-js progn-expression-single-statement
448 (return (progn (* x y)))
451 (test-ps-js cond-expression1
452 (defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)))))
454 return 1 < 2 ? (bar('foo'), 4 * 5) : null;
457 (test-ps-js cond-expression2
458 (defun foo () (return (cond ((< 2 1) "foo") ((= 7 7) "bar"))))
460 return 2 < 1 ? 'foo' : (7 == 7 ? 'bar' : null);
463 (test-ps-js cond-expression-final-t-clause
464 (defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)) ((= a b) (+ c d)) ((< 1 2 3 4 5) x) (t "foo"))))
466 return 1 < 2 ? (bar('foo'), 4 * 5) : (a == b ? c + d : (1 < 2 < 3 < 4 < 5 ? x : 'foo'));
469 (test-ps-js cond-expression-middle-t-clause ;; should this signal a warning?
470 (defun foo () (return (cond ((< 2 1) 5) (t "foo") ((< 1 2) "bar"))))
472 return 2 < 1 ? 5 : 'foo';
475 (test-ps-js funcall-if-expression
477 (if (= *linkornot* 1)
478 (ps-html ((:a :href "#"
479 :onclick (ps-inline (transport)))
482 "document.write(LINKORNOT == 1 ? '<A HREF=\"#\" ONCLICK=\"' + ('javascript:' + 'transport()') + '\">' + img + '</A>' : img)")
484 (test-ps-js negate-number-literal ;; ok, this was broken and fixed before, but no one bothered to add the test!
488 (test macro-environment1
489 (is (string= (normalize-js-code (let* ((macroname (gensym)))
490 (ps* `(defmacro ,macroname (x) `(+ ,x 123))
492 (macrolet ((,macroname (x) `(aref data ,x)))
494 (setf (,macroname x) 123)))))))
503 (test macro-environment2
504 (is (string= (normalize-js-code (let ((outer-lexical-variable 1))
505 (defpsmacro macro-environment2-macro (x)
506 `(+ ,outer-lexical-variable ,x))
507 (ps* '(macro-environment2-macro 2))))
508 (normalize-js-code "1 + 2;"))))
510 (test-ps-js ampersand-whole-1
511 (macrolet ((foo (&whole foo bar baz)
512 (declare (ignore bar baz))
513 (format nil "~a" foo)))
517 (test-ps-js keyword-consistent
521 (test-ps-js simple-symbol-macrolet
522 (symbol-macrolet ((x 1)) x)
525 (test-ps-js compound-symbol-macrolet
526 (symbol-macrolet ((x 123)
531 (test-ps-js define-symbol-macro
532 (progn (define-symbol-macro tst-sym-macro 2)
536 (test-ps-js expression-progn
537 (defun f () (return (progn (foo) (if x 1 2))))
539 return (foo(), x ? 1 : 2);
542 (test-ps-js let-decl-in-expression
543 (defun f (x) (return (if x 1 (let* ((foo x)) foo))))
546 return x ? 1 : (foo = x, foo);
549 (test-ps-js special-var1
550 (progn (defvar *foo*) (let* ((*foo* 2)) (* *foo* 2)))
559 delete tempstackvar1;
562 (test-ps-js special-var2
563 (progn (defvar *foo*) (let* ((*baz* 3) (*foo* 2)) (* *foo* 2 *baz*)))
573 delete tempstackvar1;
585 (test-ps-js setf-dec1
589 (test-ps-js setf-dec2
593 (test-ps-js special-char-equals
597 (test-ps-js setf-operator-priority
598 (return (or (slot-value cache id)
599 (setf (slot-value cache id) (document.get-element-by-id id))))
600 "return cache[id] || (cache[id] = document.getElementById(id))")
602 (test-ps-js aref-operator-priority
603 (aref (if (and x (> (length x) 0))
607 "(x && x.length > 0 ? x[0] : y)[z]")
609 (test-ps-js aref-operator-priority1
610 (aref (or (slot-value x 'y)
615 (test-ps-js aref-operator-priority2
619 (test-ps-js negative-operator-priority
628 (delete (if a (or b c) d))
629 "delete (a ? b || c : d)")
632 (not (if (or x (not y)) z))
633 "!(x || !y ? z : null)")
640 (instanceof (or a b) (if x y z))
641 "((a || b) instanceof (x ? y : z))")
644 (doeach (x (or a b)))
645 "for (var x in (a || b)) { };")
648 (or x (if (= x 0) "zero" "empty"))
649 "x || (x == 0 ? 'zero' : 'empty')")
651 (test-ps-js named-op-expression
655 (test-ps-js named-op-expression1
659 (test-ps-js aref-array-expression
663 (test-ps-js slot-value-operator
664 (slot-value (or a b c) 'd)
667 (test-ps-js slot-value-parens
668 (slot-value (slot-value foo 'bar) 'baz)
671 (test-ps-js funcall-funcall
675 (test-ps-js expression-funcall
676 ((or (@ window eval) eval) foo nil)
677 "(window.eval || eval)(foo, null)")
679 (test-ps-js expression-funcall1
680 (((or (@ window eval) eval) foo nil))
681 "(window.eval || eval)(foo, null)()")
683 (test-ps-js expression-funcall2
684 (((or (@ window eval) eval)) foo nil)
685 "(window.eval || eval)()(foo, null)")
687 (test-ps-js slot-value-object-literal
688 (slot-value (create :a 1) 'a)
691 (test-ps-js slot-value-lambda
692 (slot-value (lambda ()) 'prototype)
693 "(function () { }).prototype")
695 (test-ps-js who-html1
696 (who-ps-html (:span :class "ticker-symbol"
697 :ticker-symbol symbol
698 (:a :href "http://foo.com"
700 (:span :class "ticker-symbol-popup")))
701 "'<SPAN CLASS=\"ticker-symbol\" TICKER-SYMBOL=\"' + symbol + '\"><A HREF=\"http://foo.com\">' + symbol + '</A><SPAN CLASS=\"ticker-symbol-popup\"/></SPAN>'")
704 ((lambda () (flet ((foo (x) (return (1+ x)))) (return (foo 1)))))
706 var foo = function (x) {
713 ((lambda () (labels ((foo (x)
714 (return (if (=== 0 x)
716 (+ x (foo (1- x)))))))
719 var foo = function foo(x) {
720 return 0 === x ? 0 : x + foo(x - 1);
725 (test-ps-js for-loop-var-init-exp
727 (return (do* ((y (if x 0 1) (1+ y))
732 return (function () {
733 for (var y = x ? 0 : 1, z = 0; y != 3; y += 1, z += 1) {