setf slot-value patch
[parenscript.git] / t / test.lisp
blobb57bf97e3766db048989b9379c4d361d93822391
1 (in-package :js-test)
3 ;; Testcases for parenscript
5 (defun trim-whitespace(str)
6 (string-trim '(#\Space #\Tab #\Newline) str))
8 (defun same-space-between-statements(code)
9 (cl-ppcre:regex-replace-all "\\s*;\\s*" code (concatenate 'string (list #\; #\Newline))))
11 (defun no-indentation(code)
12 (cl-ppcre:regex-replace-all (cl-ppcre:create-scanner "^\\s*" :multi-line-mode t) code ""))
14 (defun no-trailing-spaces(code)
15 (cl-ppcre:regex-replace-all (cl-ppcre:create-scanner "\\s*$" :multi-line-mode t) code ""))
17 (defun normalize-js-code(str)
18 (trim-whitespace (no-indentation (no-trailing-spaces (same-space-between-statements str)))))
20 (defmacro test-ps-js (testname parenscript javascript)
21 `(test ,testname ()
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)
28 (normalize-js-code js-code))))))
30 (defun run-tests()
31 (format t "Running reference tests:~&")
32 (run! 'ref-tests)
33 (format t "Running other tests:~&")
34 (run! 'ps-tests))
36 ;;---------------------------------------------------------------------------
37 (def-suite ps-tests)
38 (in-suite ps-tests)
40 (test-ps-js plus-is-not-commutative
41 (setf x (+ "before" x "after"))
42 "x = 'before' + x + 'after'")
44 (test-ps-js plus-works-if-first
45 (setf x (+ x "middle" "after"))
46 "x += 'middle' + 'after'")
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))))
56 var x = 10;
57 function sideEffect() {
58 x = 4;
59 return 3;
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;
70 ;; Which is 20, not 14
73 (test-ps-js dot-notation-bug
74 (.match (+ "" x) "foo")
75 "('' + x).match('foo')")
77 (test-ps-js method-call-op-form (.to-string (+ "" x)) "('' + x).toString()")
78 (test-ps-js method-call-number (.to-string 10) "(10).toString()")
79 (test-ps-js method-call-string (.to-string "hi") "'hi'.toString()")
80 (test-ps-js method-call-lit-object
81 (.to-string (create :to-string : (lambda ()
82 (return "it works"))))
83 "({ toString : function () {
84 return 'it works';
85 } }).toString()")
87 (test-ps-js method-call-variable
88 (.to-string x)
89 "x.toString()")
91 (test-ps-js method-call-array
92 (.to-string (list 10 20))
93 "[10, 20].toString()")
94 (test-ps-js method-call-fn-call
95 (.to-string (foo))
96 "foo().toString()")
97 (test-ps-js method-call-lambda-fn
98 (.to-string (lambda () (alert 10)))
99 "(function () {alert(10);}).toString()")
100 (test-ps-js method-call-lambda-call
101 (.to-string ((lambda (x) (return x)) 10))
102 "(function (x) {return x;})(10).toString()")
104 (test no-whitespace-before-dot
105 (let* ((str (js:js* '(.to-string ((lambda (x) (return x)) 10))))
106 (dot-pos (position #\. str :test #'char=))
107 (char-before (elt str (1- dot-pos)))
108 (a-parenthesis #\)))
109 (is (char= char-before a-parenthesis))))
111 ;; A problem with long nested operator, when the statement spanned several rows
112 ;; the rows would not be joined together correctly.
113 (test-ps-js bug-dwim-join
114 (alert (html ((:div :id 777
115 :style (css-inline :border "1pxsssssssssss"
116 :font-size "x-small"
117 :height (* 2 200)
118 :width (* 2 300))))))
119 "alert
120 ('<div id=\"777\" style=\"'
121 + ('border:1pxsssssssssss;font-size:x-small;height:' + 2 * 200 + ';width:'
122 + 2 * 300)
123 + '\"></div>')") ;";This line should start with a plus character.
126 (test-ps-js simple-slot-value
127 (let ((foo (create :a 1)))
128 (alert (slot-value foo 'a)))
130 var foo = { a : 1 };
131 alert(foo.a);
134 (test-ps-js buggy-slot-value
135 (let ((foo (create :a 1))
136 (slot-name "a"))
137 (alert (slot-value foo slot-name)))
139 var foo = { a : 1 };
140 var slotName = 'a';
141 alert(foo[slotName]);
142 }"); Last line was alert(foo.slotName) before bug-fix.
144 (test-ps-js buggy-slot-value-two
145 (slot-value foo (get-slot-name))
146 "foo[getSlotName()]")
148 (test-ps-js old-case-is-now-switch
149 ;; Switch was "case" before, but that was very non-lispish.
150 ;; For example, this code makes three messages and not one
151 ;; which may have been expected. This is because a switch
152 ;; statment must have a break statement for it to return
153 ;; after the alert. Otherwise it continues on the next
154 ;; clause.
155 (switch (aref blorg i)
156 (1 (alert "one"))
157 (2 (alert "two"))
158 (default (alert "default clause")))
159 "switch (blorg[i]) {
160 case 1: alert('one');
161 case 2: alert('two');
162 default: alert('default clause');
165 (test-ps-js lisp-like-case
166 (case (aref blorg i)
167 (1 (alert "one"))
168 (2 (alert "two"))
169 (default (alert "default clause")))
170 "switch (blorg[i]) {
171 case 1:
172 alert('one');
173 break;
174 case 2:
175 alert('two');
176 break;
177 default: alert('default clause');
181 (test-ps-js even-lispier-case
182 (case (aref blorg i)
183 ((1 2) (alert "Below three"))
184 (3 (alert "Three"))
185 (t (alert "Something else")))
186 "switch (blorg[i]) {
187 case 1: ;
188 case 2:
189 alert('Below three');
190 break;
191 case 3:
192 alert('Three');
193 break;
194 default: alert('Something else');
197 (test-ps-js otherwise-case
198 (case (aref blorg i)
199 (1 (alert "one"))
200 (otherwise (alert "default clause")))
201 "switch (blorg[i]) {
202 case 1:
203 alert('one');
204 break;
205 default: alert('default clause');
208 (test escape-sequences-in-string
209 (let ((escapes `((#\\ . #\\)
210 (#\b . #\Backspace)
211 (#\f . #\Form)
212 ("u000b" . ,(code-char #x000b));;Vertical tab, too uncommon to bother with
213 (#\n . #\Newline)
214 (#\r . #\Return)
215 (#\' . #\');;Double quote need not be quoted because parenscript strings are single quoted
216 (#\t . #\Tab)
217 ("u001f" . ,(code-char #x001f));; character below 32
218 ("u0080" . ,(code-char 128)) ;;Character over 127. Actually valid, parenscript escapes them to be sure.
219 ("uabcd" . ,(code-char #xabcd)))));; Really above ascii.
220 (loop for (js-escape . lisp-char) in escapes
221 for generated = (js-to-string `(let ((x , (format nil "hello~ahi" lisp-char)))))
222 for wanted = (format nil "{
223 var x = 'hello\\~ahi';
224 }" js-escape)
225 do (is (string= generated wanted)))))