Commit | Line | Data |
---|---|---|
eb17f15c | 1 | (in-package :js-test) |
711dd89e | 2 | |
eb17f15c HH |
3 | ;; Testcases for parenscript |
4 | ||
5 | (defun trim-whitespace(str) | |
6 | (string-trim '(#\Space #\Tab #\Newline) str)) | |
7 | ||
7a7d6c73 HH |
8 | (defun same-space-between-statements(code) |
9 | (cl-ppcre:regex-replace-all "\\s*;\\s*" code (concatenate 'string (list #\; #\Newline)))) | |
10 | ||
11 | (defun no-indentation(code) | |
12 | (cl-ppcre:regex-replace-all (cl-ppcre:create-scanner "^\\s*" :multi-line-mode t) code "")) | |
13 | ||
14 | (defun no-trailing-spaces(code) | |
15 | (cl-ppcre:regex-replace-all (cl-ppcre:create-scanner "\\s*$" :multi-line-mode t) code "")) | |
16 | ||
17 | (defun normalize-js-code(str) | |
18 | (trim-whitespace (no-indentation (no-trailing-spaces (same-space-between-statements str))))) | |
19 | ||
eb17f15c HH |
20 | (defmacro test-ps-js (testname parenscript javascript) |
21 | `(test ,testname () | |
7a7d6c73 HH |
22 | (setf js::*var-counter* 0) |
23 | ;; is-macro expands its argument again when reporting failures, so | |
24 | ;; the reported temporary js-variables get wrong if we don't evalute first. | |
25 | (let ((generated-code (js-to-string ',parenscript)) | |
26 | (js-code ,javascript)) | |
27 | (is (string= (normalize-js-code generated-code) | |
94a05cdf | 28 | (normalize-js-code js-code)))))) |
eb17f15c HH |
29 | |
30 | (defun run-tests() | |
711dd89e HH |
31 | (format t "Running reference tests:~&") |
32 | (run! 'ref-tests) | |
33 | (format t "Running other tests:~&") | |
34 | (run! 'ps-tests)) | |
35 | ||
36 | ;;--------------------------------------------------------------------------- | |
37 | (def-suite ps-tests) | |
38 | (in-suite ps-tests) | |
39 | ||
edc8cc52 HH |
40 | (test-ps-js plus-is-not-commutative |
41 | (setf x (+ "before" x "after")) | |
5801feb8 HH |
42 | "x = 'before' + x + 'after'") |
43 | ||
44 | (test-ps-js plus-works-if-first | |
45 | (setf x (+ x "middle" "after")) | |
46 | "x += 'middle' + 'after'") | |
47 | ||
48 | (test-ps-js setf-side-effects | |
49 | (progn | |
50 | (let ((x 10)) | |
51 | (defun side-effect() | |
52 | (setf x 4) | |
53 | (return 3)) | |
54 | (setf x (+ 2 (side-effect) x 5)))) | |
55 | " | |
56 | var x = 10; | |
57 | function sideEffect() { | |
58 | x = 4; | |
59 | return 3; | |
60 | }; | |
61 | x = 2 + sideEffect() + x + 5;") | |
62 | ;; Parenscript used to optimize to much: | |
63 | ;; var x = 10; | |
64 | ;; function sideEffect() { | |
65 | ;; x = 4; | |
66 | ;; return 3; | |
67 | ;; }; | |
68 | ;; x += 2 + sideEffect() + 5; | |
69 | ;; | |
70 | ;; Which is 20, not 14 | |
71 | ||
edc8cc52 HH |
72 | |
73 | (test-ps-js dot-notation-bug | |
74 | (.match (+ "" x) "foo") | |
75 | "('' + x).match('foo')") | |
76 | ||
047be2b7 HH |
77 | (test-ps-js method-call-number (.to-string 10) "(10).toString()") |
78 | (test-ps-js method-call-string (.to-string "hi") "'hi'.toString()") | |
79 | (test-ps-js method-call-lit-object | |
80 | (.to-string (create :to-string : (lambda () | |
81 | (return "it works")))) | |
82 | "({ toString : function () { | |
83 | return 'it works'; | |
84 | } }).toString();") | |
85 | ||
86 | (test-ps-js method-call-variable | |
87 | (.to-string x) | |
88 | "x.toString();") | |
89 | ||
90 | (test-ps-js method-call-array | |
91 | (.to-string (list 10 20)) | |
92 | "[10, 20].toString();") | |
93 | (test-ps-js method-call-fn-call | |
94 | (.to-string (foo)) | |
95 | "foo().toString();") | |
96 | (test-ps-js method-call-lambda-fn | |
97 | (.to-string (lambda () (alert 10))) | |
98 | "(function () {alert(10);}).toString();") | |
99 | (test-ps-js method-call-lambda-call | |
100 | (.to-string ((lambda (x) (return x)) 10)) | |
101 | "(function (x) {return x;})(10).toString();") | |
102 | ||
103 | ||
711dd89e HH |
104 | ;; A problem with long nested operator, when the statement spanned several rows |
105 | ;; the rows would not be joined together correctly. | |
106 | (test-ps-js bug-dwim-join | |
107 | (alert (html ((:div :id 777 | |
108 | :style (css-inline :border "1pxsssssssssss" | |
109 | :font-size "x-small" | |
110 | :height (* 2 200) | |
111 | :width (* 2 300)))))) | |
112 | "alert | |
113 | ('<div id=\"777\" style=\"' | |
114 | + ('border:1pxsssssssssss;font-size:x-small;height:' + 2 * 200 + ';width:' | |
115 | + 2 * 300) | |
116 | + '\"></div>')") ;";This line should start with a plus character. | |
0c659e80 HH |
117 | |
118 | ||
94a05cdf | 119 | (test-ps-js simple-slot-value |
0c659e80 HH |
120 | (let ((foo (create :a 1))) |
121 | (alert (slot-value foo 'a))) | |
122 | "{ | |
123 | var foo = { a : 1 }; | |
124 | alert(foo.a); | |
125 | }") | |
126 | ||
94a05cdf | 127 | (test-ps-js buggy-slot-value |
0c659e80 HH |
128 | (let ((foo (create :a 1)) |
129 | (slot-name "a")) | |
130 | (alert (slot-value foo slot-name))) | |
131 | "{ | |
132 | var foo = { a : 1 }; | |
133 | var slotName = 'a'; | |
134 | alert(foo[slotName]); | |
135 | }"); Last line was alert(foo.slotName) before bug-fix. | |
136 | ||
137 | (test-ps-js buggy-slot-value-two | |
138 | (slot-value foo (get-slot-name)) | |
139 | "foo[getSlotName()]") | |
3c393e09 HH |
140 | |
141 | (test-ps-js old-case-is-now-switch | |
142 | ;; Switch was "case" before, but that was very non-lispish. | |
143 | ;; For example, this code makes three messages and not one | |
144 | ;; which may have been expected. This is because a switch | |
145 | ;; statment must have a break statement for it to return | |
146 | ;; after the alert. Otherwise it continues on the next | |
147 | ;; clause. | |
148 | (switch (aref blorg i) | |
149 | (1 (alert "one")) | |
150 | (2 (alert "two")) | |
151 | (default (alert "default clause"))) | |
152 | "switch (blorg[i]) { | |
153 | case 1: alert('one'); | |
154 | case 2: alert('two'); | |
155 | default: alert('default clause'); | |
156 | }") | |
157 | ||
158 | (test-ps-js lisp-like-case | |
159 | (case (aref blorg i) | |
160 | (1 (alert "one")) | |
161 | (2 (alert "two")) | |
162 | (default (alert "default clause"))) | |
163 | "switch (blorg[i]) { | |
164 | case 1: | |
165 | alert('one'); | |
166 | break; | |
167 | case 2: | |
168 | alert('two'); | |
169 | break; | |
170 | default: alert('default clause'); | |
171 | }") | |
172 | ||
173 | ||
174 | (test-ps-js even-lispier-case | |
175 | (case (aref blorg i) | |
176 | ((1 2) (alert "Below three")) | |
177 | (3 (alert "Three")) | |
178 | (t (alert "Something else"))) | |
179 | "switch (blorg[i]) { | |
180 | case 1: ; | |
181 | case 2: | |
182 | alert('Below three'); | |
183 | break; | |
184 | case 3: | |
185 | alert('Three'); | |
186 | break; | |
187 | default: alert('Something else'); | |
188 | }") | |
189 | ||
190 | (test-ps-js otherwise-case | |
191 | (case (aref blorg i) | |
192 | (1 (alert "one")) | |
193 | (otherwise (alert "default clause"))) | |
194 | "switch (blorg[i]) { | |
195 | case 1: | |
196 | alert('one'); | |
197 | break; | |
198 | default: alert('default clause'); | |
199 | }") | |
72fcbf89 HH |
200 | |
201 | (test escape-sequences-in-string | |
202 | (let ((escapes `((#\\ . #\\) | |
203 | (#\b . #\Backspace) | |
204 | (#\f . #\Form) | |
f98cb20f | 205 | ("u000b" . ,(code-char #x000b));;Vertical tab, too uncommon to bother with |
72fcbf89 HH |
206 | (#\n . #\Newline) |
207 | (#\r . #\Return) | |
208 | (#\' . #\');;Double quote need not be quoted because parenscript strings are single quoted | |
209 | (#\t . #\Tab) | |
f98cb20f | 210 | ("u001f" . ,(code-char #x001f));; character below 32 |
72fcbf89 | 211 | ("u0080" . ,(code-char 128)) ;;Character over 127. Actually valid, parenscript escapes them to be sure. |
f98cb20f | 212 | ("uabcd" . ,(code-char #xabcd)))));; Really above ascii. |
72fcbf89 HH |
213 | (loop for (js-escape . lisp-char) in escapes |
214 | for generated = (js-to-string `(let ((x , (format nil "hello~ahi" lisp-char))))) | |
215 | for wanted = (format nil "{ | |
216 | var x = 'hello\\~ahi'; | |
217 | }" js-escape) | |
218 | do (is (string= generated wanted))))) |