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 too much:
32 ;; function sideEffect() {
36 ;; x += 2 + sideEffect() + 5;
38 ;; Which is 20, not 14
41 (test-ps-js dot-notation-bug
42 (.match
(+ "" x
) "foo")
43 "('' + x).match('foo')")
45 (test-ps-js method-call-op-form
(.to-string
(+ "" x
)) "('' + x).toString()")
46 (test-ps-js method-call-number
(.to-string
10) "( 10 ).toString()")
47 (test-ps-js method-call-string
(.to-string
"hi") "'hi'.toString()")
48 (test-ps-js method-call-lit-object
49 (.to-string
(create :to-string
(lambda ()
50 (return "it works"))))
51 "( { toString : function () { return 'it works'; } } ).toString()")
53 (test-ps-js method-call-variable
57 (test-ps-js method-call-array
58 (.to-string
(list 10 20))
59 "[ 10, 20 ].toString()")
60 (test-ps-js method-call-fn-call
63 (test-ps-js method-call-lambda-fn
64 (.to-string
(lambda () (alert 10)))
65 "( function () { alert(10); } ).toString()")
66 (test-ps-js method-call-lambda-call
67 (.to-string
((lambda (x) (return x
)) 10))
68 "(function (x) { return x; })(10).toString()")
70 (test no-whitespace-before-dot
71 (let* ((str (compile-script '(.to-string
((lambda (x) (return x
)) 10))))
72 (dot-pos (position #\. str
:test
#'char
=))
73 (char-before (elt str
(1- dot-pos
)))
75 (is (char= char-before a-parenthesis
))))
77 (test-ps-js simple-slot-value
78 (let* ((foo (create :a
1)))
79 (alert (slot-value foo
'a
)))
83 (test-ps-js buggy-slot-value
84 (let* ((foo (create :a
1))
86 (alert (slot-value foo slot-name
)))
87 " var foo = { a : 1 };
90 "); Last line was alert(foo.slotName) before bug-fix.
92 (test-ps-js buggy-slot-value-two
93 (slot-value foo
(get-slot-name))
96 (test-ps-js old-case-is-now-switch
97 ;; Switch was "case" before, but that was very non-lispish.
98 ;; For example, this code makes three messages and not one
99 ;; which may have been expected. This is because a switch
100 ;; statment must have a break statement for it to return
101 ;; after the alert. Otherwise it continues on the next
103 (switch (aref blorg i
)
106 (default (alert "default clause")))
108 case 1: alert('one');
109 case 2: alert('two');
110 default: alert('default clause');
113 (test-ps-js lisp-like-case
117 (default (alert "default clause")))
125 default: alert('default clause');
129 (test-ps-js even-lispier-case
131 ((1 2) (alert "Below three"))
133 (t (alert "Something else")))
137 alert('Below three');
142 default: alert('Something else');
145 (test-ps-js otherwise-case
148 (otherwise (alert "default clause")))
153 default: alert('default clause');
156 (test escape-sequences-in-string
157 (let ((escapes `((#\\ .
#\\)
159 (#\f .
,(code-char 12))
160 ("u000B" .
,(code-char #x000b
));;Vertical tab, too uncommon to bother with
163 (#\' .
#\');;Double quote need not be quoted because parenscript strings are single quoted
165 ("u001F" .
,(code-char #x001f
));; character below 32
166 ("u0080" .
,(code-char 128)) ;;Character over 127. Actually valid, parenscript escapes them to be sure.
167 ("uABCD" .
,(code-char #xabcd
)))));; Really above ascii.
168 (loop for
(js-escape . lisp-char
) in escapes
169 for generated
= (compile-script `(let* ((x ,(format nil
"hello~ahi" lisp-char
)))))
170 for wanted
= (format nil
"var x = 'hello\\~ahi';" js-escape
)
171 do
(is (string= (normalize-js-code generated
) wanted
)))))
173 (test-ps-js complicated-symbol-name1
177 (test-ps-js complicated-symbol-name2
181 (test-ps-js slot-value-setf
182 (setf (slot-value x 'y) (+ (+ a 3) 4))
183 "x.y = (a + 3) + 4;")
185 (test-ps-js slot-value-conditional1
186 (slot-value (if zoo foo bar) 'x)
187 "(zoo ? foo : bar).x")
189 (test-ps-js slot-value-conditional2
190 (slot-value (if (not zoo) foo bar) 'x)
191 "(!zoo ? foo : bar).x")
193 (test script-star-eval1
194 (is (string= "x = 1; y = 2;" (normalize-js-code (ps* '(setf x 1) '(setf y 2))))))
196 (test script-star-eval2
197 (is (string= "x = 1;" (normalize-js-code (ps* '(setf x 1))))))
199 (test-ps-js slot-value-null1
203 (test-ps-js slot-value-null2
204 (slot-value foo 'nil)
207 (test-ps-js unquoted-nil
211 (test-ps-js list-with-single-nil
215 (test-ps-js quoted-nil
220 (ps (defsetf baz (x y) (newval) `(set-baz ,x ,y ,newval)))
221 (is (string= "var _js2 = 1; var _js3 = 2; var _js1 = 3; setBaz(_js2, _js3, _js1);"
222 (normalize-js-code (let* ((ps:*ps-gensym-counter* 0))
223 (ps (setf (baz 1 2) 3)))))))
226 (ps (defsetf baz set-baz "blah"))
227 (is (string= "setBaz(1, 2, 3, 'foo');" (normalize-js-code (ps (setf (baz 1 2 3) "foo"))))))
230 (is (and (string= (normalize-js-code (ps:ps (defun (setf some-thing) (new-val i1 i2)
231 (setf (aref *some-thing* i1 i2) new-val))))
232 "function __setf_someThing(newVal, i1, i2) { SOMETHING[i1][i2] = newVal; };")
233 (string= (let ((ps:*ps-gensym-counter* 0)) (normalize-js-code (ps:ps (setf (some-thing 1 2) "foo"))))
234 "var _js2 = 1; var _js3 = 2; var _js1 = 'foo'; __setf_someThing(_js1, _js2, _js3);"))))
236 (test-ps-js defun-optional1
237 (defun test-opt (&optional x) (return (if x "yes" "no")))
238 "function testOpt(x) {
239 x = undefined === x && null || x;
240 return x ? 'yes' : 'no';
243 (test-ps-js defun-optional2
244 (defun foo (x &optional y) (+ x y))
245 "function foo(x, y) {
246 y = undefined === y && null || y;
250 (test-ps-js return-nothing
254 (test-ps-js set-timeout
255 (do-set-timeout (10) (alert "foo"))
256 "setTimeout(function () { alert('foo'); }, 10)")
257 (test-ps-js operator-precedence
277 (test-ps-js setf-conditional
278 (setf foo (if x 1 2))
281 (test-ps-js obj-literal-numbers
285 (test-ps-js obj-literal-strings
289 (test-ps-js slot-value-string
290 (slot-value foo "bar")
293 (test-ps-js slot-value-progn
294 (slot-value (progn (some-fun "abc") "123") "length")
295 "(someFun('abc'), '123')['length']")
297 (test-ps-js method-call-block
298 (.to-string (progn (some-fun "abc") "123"))
299 "(someFun('abc'), '123').toString()")
301 (test-ps-js create-blank
305 (test-ps-js blank-object-literal
309 (test-ps-js defun-rest1
310 (defun foo (&rest bar) (alert bar[1]))
313 for (var i2 = 0; i2 < arguments.length - 0; i2 += 1) {
314 bar[i2] = arguments[i2 + 0];
319 (test-ps-js defun-rest2
320 (defun foo (baz &rest bar) (return (+ baz (aref bar 1))))
323 for (var i2 = 0; i2 < arguments.length - 1; i2 += 1) {
324 bar[i2] = arguments[i2 + 1];
329 (test-ps-js defun-keyword1
330 (defun zoo (foo bar &key baz) (return (+ foo bar baz)))
331 "function zoo(foo, bar, _js1) {
332 _js1 = undefined === _js1 && { } || _js1;
333 return foo + bar + _js1.baz;
343 (cond ((= x 1) 2) ((= y (* x 4)) (foo "blah") (* x y)))
346 } else if (y == x * 4) {
351 (test-ps-js if-exp-without-else-returns-null
353 "return x ? 1 : null")
355 (test-ps-js progn-expression-single-statement
356 (return (progn (* x y)))
359 (test-ps-js cond-expression1
360 (defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)))))
362 return 1 < 2 ? (bar('foo'), 4 * 5) : null;
365 (test-ps-js cond-expression2
366 (defun foo () (return (cond ((< 2 1) "foo") ((= 7 7) "bar"))))
368 return 2 < 1 ? 'foo' : (7 == 7 ? 'bar' : null);
371 (test-ps-js cond-expression-final-t-clause
372 (defun foo () (return (cond ((< 1 2) (bar "foo") (* 4 5)) ((= a b) (+ c d)) ((< 1 2 3 4 5) x) (t "foo"))))
374 return 1 < 2 ? (bar('foo'), 4 * 5) : (a == b ? c + d : (1 < 2 < 3 < 4 < 5 ? x : 'foo'));
377 (test-ps-js cond-expression-middle-t-clause ;; should this signal a warning?
378 (defun foo () (return (cond ((< 2 1) 5) (t "foo") ((< 1 2) "bar"))))
380 return 2 < 1 ? 5 : 'foo';
383 (test-ps-js funcall-if-expression
385 (if (= *linkornot* 1)
386 (ps-html ((:a :href "#"
387 :onclick (lisp (ps-inline (transport))))
390 "document.write(LINKORNOT == 1 ? '<a href=\"#\" onclick=\"' + 'javascript:transport()' + '\">' + img + '</a>' : img)")
392 (test-ps-js negate-number-literal ;; ok, this was broken and fixed before, but no one bothered to add the test!
396 (test macro-environment1
397 (is (string= (normalize-js-code (let* ((macroname (gensym)))
398 (ps* `(defmacro ,macroname (x) `(+ ,x 123))
400 (macrolet ((,macroname (x) `(aref data ,x)))
402 (setf (,macroname x) 123)))))))
411 (test-ps-js ampersand-whole-1
412 (macrolet ((foo (&whole foo bar baz)
413 (declare (ignore bar baz))
414 (format nil "~a" foo)))
418 (test-ps-js keyword-consistent
422 (test-ps-js simple-symbol-macrolet
423 (symbol-macrolet ((x 1)) x)
426 (test-ps-js compound-symbol-macrolet
427 (symbol-macrolet ((x 123)
432 (test-ps-js define-symbol-macro
433 (progn (define-symbol-macro tst-sym-macro 2)
437 (test-ps-js expression-progn
438 (defun f () (return (progn (foo) (if x 1 2))))
440 return (foo(), x ? 1 : 2);
443 (test-ps-js let-decl-in-expression
444 (defun f (x) (return (if x 1 (let* ((foo x)) foo))))
447 return x ? 1 : (foo = x, foo);
450 (test-ps-js special-var1
451 (progn (defvar *foo*) (let* ((*foo* 2)) (* *foo* 2)))
460 delete tempstackvar1;
463 (test-ps-js special-var2
464 (progn (defvar *foo*) (let* ((*baz* 3) (*foo* 2)) (* *foo* 2 *baz*)))
474 delete tempstackvar1;
486 (test-ps-js setf-dec1
490 (test-ps-js setf-dec2
494 (test-ps-js special-char-equals