source: project/release/4/ersatz/trunk/tests/run.scm @ 26863

Last change on this file since 26863 was 26863, checked in by Ivan Raikov, 9 years ago

ersatz: implement a procedure for easy creation of custom lexers and added tests

File size: 15.4 KB
Line 
1
2
3(use test ersatz-lib datatype)
4
5(define kwargs '())
6
7(define (tval-equal? t1 t2)
8  (cases tvalue (eq-eq t1 t2)
9         (Tbool (ret) ret)
10         (else (error 'tval-equal "invalid value"))))
11
12(test-group "runtime test"
13
14
15  (test-group "tvalue string representation"
16              (test "a"   (->string (Tstr "a")))
17              (test "1"   (->string (Tint 1)))
18              (test "1.0"  (->string (Tfloat 1.0)))
19              (test "1.2"  (->string (Tfloat 1.2)))
20              (test "<list>"  (->string (Tlist (list (Tint 0) (Tint 1)))))
21              (test "<obj>"  (->string (Tobj (list (cons 'name (Tstr "value"))))))
22              )
23
24  (test-group "arithmetic and logic"
25              (test (Tint 2)     (op-plus (Tint 1) (Tint 1)))
26              (test (Tfloat 2.0) (op-plus (Tfloat 1.0) (Tfloat 1.0)))
27              (test (Tint 0)     (op-minus (Tint 1) (Tint 1)))
28              (test (Tint 2)     (op-minus (Tint 1) (Tint -1)))
29              (test (Tfloat -1.0) (op-minus (Tint 0) (Tfloat 1.0)))
30              (test (Tfloat 1.0)    (op-minus (Tint 1) (Tfloat 0.0)))
31              (test-assert (tval-equal? (op-abs (Tint -1) kwargs) (Tint 1)))
32              (test-assert (tval-equal? (op-abs (Tint 1) kwargs) (Tint 1)))
33              (test-assert (tval-equal? (op-round (Tstr "floor") (Tfloat 1.5) kwargs) 
34                                        (Tfloat 1.0)))
35              (test-assert (tval-equal? (op-round (Tstr "ceil") (Tfloat 1.5) kwargs) 
36                                        (Tfloat 2.0)))
37              (test-assert (tval-equal? (op-range (Tint 0) (Tint 2) kwargs) 
38                                        (Tlist (list (Tint 0) (Tint 1) (Tint 2)))))
39              (test-assert (tval-equal? (op-range (Tint 2) (Tint 0) kwargs) 
40                                        (Tlist (list (Tint 2) (Tint 1) (Tint 0)))))
41              (test-assert (tval-equal? (op-range (Tint 2012) (Tint 2006) kwargs) 
42                                        (Tlist (list (Tint 2012) (Tint 2011) (Tint 2010) (Tint 2009) 
43                                                     (Tint 2008) (Tint 2007) (Tint 2006)))))
44;;            (test-assert (tval-equal? (op-sum (Tlist (Tint 0) (Tint 1) (Tint 2) kwargs))
45;;                                      (Tint 3)))
46;;            (test-assert (tval-equal? (op-sum (Tlist (Tint 0) (Tint 1) (Tfloat 2.1) kwargs))
47;;                                      (Tfloat 3.1)))
48
49
50              (test-assert (tval-equal? (op-times (Tint 0) (Tint 1)) (Tint 0)))
51              (test-assert (tval-equal? (op-times (Tint 1) (Tint 1)) (Tint 1)))
52              (test-assert (tval-equal? (op-times (Tint 2) (Tint 2)) (Tint 4)))
53              (test-assert (tval-equal? (op-times (Tfloat 1.0) (Tint 2)) (Tfloat 2.0)))
54              (test-assert (tval-equal? (op-times (Tfloat 2.0) (Tfloat 2.0)) (Tfloat 4.0)))
55              (test-assert (tval-equal? (op-times (Tfloat 0.0) (Tfloat 2.0)) (Tfloat 0.0)))
56              (test-assert (tval-equal? (op-times (Tfloat 0.0) (Tint 1)) (Tfloat 0.0)))
57
58              (test-assert (tval-equal? (op-power (Tint 2) (Tint -1)) (Tfloat 1.0)))
59              (test-assert (tval-equal? (op-power (Tint 2) (Tint 0)) (Tfloat 1.0)))
60              (test-assert (tval-equal? (op-power (Tint 2) (Tint 1)) (Tfloat 2.0)))
61              (test-assert (tval-equal? (op-power (Tint 2) (Tint 10)) (Tfloat 1024.0)))
62
63              (test-assert (tval-equal? (op-div (Tint 4) (Tint 2)) (Tint 2)))
64              (test-assert (tval-equal? (op-div (Tfloat 4.0) (Tint 2)) (Tfloat 2.0)))
65
66              (test-assert (tval-equal? (op-mod (Tint 4) (Tint 3)) (Tint 1)))
67              (test-assert (tval-equal? (op-mod (Tint 4) (Tint 1)) (Tint 0)))
68
69              (test-assert (tval-equal? (op-and (Tbool #t) (Tbool #t)) (Tbool #t)))
70              (test-assert (tval-equal? (op-and (Tbool #t) (Tbool #f)) (Tbool #f)))
71              (test-assert (tval-equal? (op-and (Tbool #f) (Tbool #t)) (Tbool #f)))
72              (test-assert (tval-equal? (op-and (Tbool #f) (Tbool #f)) (Tbool #f)))
73
74              (test-assert (tval-equal? (op-or (Tbool #t) (Tbool #t)) (Tbool #t)))
75              (test-assert (tval-equal? (op-or (Tbool #t) (Tbool #f)) (Tbool #t)))
76              (test-assert (tval-equal? (op-or (Tbool #f) (Tbool #t)) (Tbool #t)))
77              (test-assert (tval-equal? (op-or (Tbool #f) (Tbool #f)) (Tbool #f)))
78
79
80              (test-assert (tval-equal? (op-toint (Tint 1) kwargs) (Tint 1)))
81              (test-assert (tval-equal? (op-toint (Tfloat 1.0) kwargs) (Tint 1)))
82              (test-assert (tval-equal? (op-tofloat (Tint 1) kwargs) (Tfloat 1.0)))
83              (test-assert (tval-equal? (op-tofloat (Tfloat 1.0) kwargs) (Tfloat 1.0)))
84              )
85
86
87  (let ((lst1 (Tlist (list (Tint 0) (Tint 1) (Tint 2))))
88        (lst2 (Tlist (list (Tint 0) (Tint 1) (Tint 2))))
89        (lst3 (Tlist (list (Tint 0) (Tint 1) (Tint 3))))
90        (lst4 (Tlist (list (Tint 0) (Tint 1)))))
91    (test-group "list equality"
92                (test-assert (tval-equal? (Tbool #t) (list-same lst1 lst2)))
93                (test-assert (tval-equal? (Tbool #f) (list-same lst1 lst3)))
94                (test-assert (tval-equal? (Tbool #f) (list-same lst1 lst4)))))
95                             
96  (let ((obj1 (Tobj (list (cons 'name (Tstr "john"))
97                          (cons 'age  (Tint 20)))))
98        (obj2 (Tobj (list (cons 'name (Tstr "john"))
99                          (cons 'age  (Tint 20)))))
100        (obj3 (Tobj (list (cons 'name (Tstr "mary"))
101                          (cons 'age  (Tint 22)))))
102        (obj4 (Tobj (list (cons 'age (Tint 20))
103                          (cons 'name (Tstr "john"))))))
104    (test-group "object equality"
105                (test-assert (tval-equal?  (Tbool #t) (obj-same obj1 obj2)))
106                (test-assert (tval-equal?  (Tbool #f) (obj-same obj1 obj3)))
107                (test-assert (tval-equal? (Tbool #t) (obj-same obj1 obj4))))
108    )
109
110
111  (test-group "eq-eq"
112              (test-assert (tval-equal? (eq-eq (Tint 1) (Tint 1)) (Tbool #t)))
113              (test-assert (tval-equal? (eq-eq (Tint 1) (Tfloat 1.0)) (Tbool #f)))
114              (test-assert (tval-equal? (eq-eq (Tfloat 1.0) (Tfloat 1.0)) (Tbool #t)))
115              (test-assert (tval-equal? (eq-eq (Tstr "aaa") (Tstr "aaa")) (Tbool #t)))
116              (test-assert (tval-equal? (eq-eq (Tstr "aaa") (Tstr "bbb")) (Tbool #f)))
117              (test-assert (tval-equal? (eq-eq (Tstr "日本語") (Tstr "日本語")) (Tbool #t)))
118              (test-assert (tval-equal? (eq-eq (Tstr "日本語") (Tstr "英語")) (Tbool #f)))
119              (test-assert (tval-equal? (eq-eq (Tstr "aaa") (Tint 0)) (Tbool #f)))
120   )
121
122  (test-group "string operations"
123              (test-assert "upper" (tval-equal? (op-upper (Tstr "aaa") kwargs) (Tstr "AAA")))
124              (test-assert "lower" (tval-equal? (op-lower (Tstr "AAA") kwargs) (Tstr "aaa")))
125              (test-assert "join" (tval-equal? (op-join (Tstr ",") (Tlist (list (Tstr "a") (Tstr "b"))) kwargs) (Tstr "a,b")))
126              (test-assert "substring" (tval-equal? (op-substring (Tint 0) (Tint 1) (Tstr "hello") kwargs) (Tstr "h")))
127              (test-assert "substring" (tval-equal? (op-substring (Tint 4) (Tint 1) (Tstr "hello") kwargs) (Tstr "o")))
128              (test-assert "substring" (tval-equal? (op-substring (Tint 0) (Tint 2) (Tstr "hello") kwargs) (Tstr "he")))
129              (test-assert "substring" (tval-equal? (op-substring (Tint 0) (Tint 2) (Tstr "日本語") kwargs) (Tstr "日本")))
130
131              (test-assert "replace" (tval-equal? (op-replace (Tstr "t") (Tstr "d") (Tstr "test") kwargs) (Tstr "desd")))
132              (test-assert "replace" (tval-equal? (op-replace (Tstr "te") (Tstr "ta") (Tstr "test") kwargs) (Tstr "tast")))
133              (test-assert "replace" (tval-equal? (op-replace (Tstr "日") (Tstr "英") (Tstr "日語") kwargs) (Tstr "英語")))
134
135              (test-assert "truncate"
136                           (tval-equal? (op-truncate (Tint 3) (Tstr "123456789") kwargs) (Tstr "123")))
137
138              (test-assert "capitalize"
139                           (tval-equal? (op-capitalize (Tstr "car") kwargs) (Tstr "Car")))
140
141              (test-assert "escape-html"
142                           (tval-equal?
143                            (Tstr "&lt;script&gt;") 
144                            (op-escape-html (Tstr "<script>") kwargs)
145                            ))
146
147
148              (test-assert "wordcount" 
149                           (tval-equal?
150                            (op-wordcount (Tstr "xy yz zz") kwargs) (Tint 3)))
151             
152              (test-assert "wordcount" 
153                           (tval-equal?
154                            (op-wordcount (Tstr "英語 日語") kwargs) (Tint 2)))
155
156              (test-assert "urlize" 
157                           (tval-equal?
158                            (op-urlize (Tstr "go to http://yahoo.co.jp" ) kwargs) 
159                            (Tstr "go to <a href='http://yahoo.co.jp'>http://yahoo.co.jp</a>")))
160
161              (test-assert "title" 
162                           (tval-equal?
163                            (op-title (Tstr "this is a title" ) kwargs) 
164                            (Tstr "This Is A Title")))
165
166              (test-assert "striptags" 
167                           (tval-equal?
168                            (op-striptags (Tstr "<p class='indent'>xxx</p> yyy <b>zzz</b>" ) kwargs) 
169                            (Tstr "xxx yyy zzz")))
170
171              )
172
173
174  (test-group "sorting"
175
176              (let ((lst  (Tlist (list (Tint 3) (Tint 1) (Tint 2)))))
177                (test-assert (tval-equal? (op-sort lst kwargs)
178                                          (Tlist (list (Tint 1) (Tint 2) (Tint 3))))))
179
180              (let ((lst (Tlist (list (Tfloat 3.0) (Tfloat 1.0) (Tfloat 2.0)))))
181                (test-assert (tval-equal? (op-sort lst kwargs)
182                                          (Tlist (list (Tfloat 1.0) (Tfloat 2.0) (Tfloat 3.0))))))
183
184              (let ((lst (Tlist (list (Tstr "baba") (Tstr "aa") (Tstr "kaka")))))
185                (test-assert (tval-equal? (op-sort lst kwargs)
186                                          (Tlist (list (Tstr "aa") (Tstr "baba") (Tstr "kaka"))))))
187              )
188
189
190  (test-group "length"
191              (test-assert (tval-equal? (op-length (Tstr "test") kwargs) (Tint 4)))
192              (test-assert (tval-equal? (op-length (Tstr "日本語") kwargs) (Tint 3)))
193              (test-assert (tval-equal? (op-length (Tlist (list (Tint 0) (Tint 1))) kwargs) (Tint 2)))
194              )
195
196  (test-assert "reverse"  (tval-equal? (op-reverse (Tlist (list (Tint 0) (Tint 1) (Tint 2))) kwargs)
197                                       (Tlist (list (Tint 2) (Tint 1) (Tint 0)))))
198
199 
200  (test-assert "slice"  (tval-equal? (op-slice (Tint 2) (Tlist (list (Tint 0) (Tint 1) (Tint 2) (Tint 3) (Tint 4))) kwargs)
201                                     (Tlist (list
202                                             (Tlist (list (Tint 0) (Tint 1)))
203                                             (Tlist (list (Tint 2) (Tint 3)))
204                                             (Tlist (list (Tint 4)))))))
205
206  (test-assert "last" (tval-equal? (op-last (Tlist (list (Tint 0) (Tint 1) (Tint 2))) kwargs)
207                                   (Tint 2)))
208
209  (test-assert "default" (tval-equal? (op-default (Tstr "hello") (Tnull) kwargs) (Tstr "hello")))
210
211  (test-assert "list" (tval-equal? (op-list (Tstr "test") kwargs)
212                                   (Tlist (list (Tstr "t") (Tstr "e") (Tstr "s") (Tstr "t")))))
213
214  (test-assert "sublist" (tval-equal? (op-sublist (Tint 1) (Tint 3) (Tlist (list (Tint 0) (Tint 1) (Tint 2) (Tint 3))) kwargs)
215                                      (Tlist (list (Tint 1) (Tint 2) (Tint 3)))))
216
217  (test-assert "expand and escape"
218               (let* ((script "<script>alert(1)</script>")
219                      (output (from-string "{{danger}}" 
220                                           models: (list (cons 'danger (Tstr script)))))
221                      )
222                 (tval-equal? (Tstr output) (op-escape-html (Tstr script) kwargs))))
223
224  (test-assert "safe expand"
225               (let* ((script "<script>alert(1)</script>")
226                      (output (from-string "{{danger|safe}}" 
227                                           models: (list (cons 'danger (Tstr script)))))
228                      )
229                 (tval-equal? (Tstr output) (Tstr script))))
230
231  (test-assert "expand with filter"
232               (let* ( (output (from-string "{{pi|int}}" 
233                                           models: (list (cons 'pi (Tfloat 3.14)))))
234                      )
235                 (tval-equal? (Tstr output) (Tstr "3"))))
236
237  (test-assert "expand with if"
238               (let* ( (source "{% if x == 1 %}one{% elseif x == 2 %}two{% else %}three{% endif %}") )
239                 (and (tval-equal? (Tstr (from-string source
240                                                      models: (list (cons 'x (Tint 1)))))
241                                   (Tstr "one"))
242                      (tval-equal? (Tstr (from-string source
243                                                      models: (list (cons 'x (Tint 2)))))
244                                   (Tstr "two"))
245                      (tval-equal? (Tstr (from-string source
246                                                      models: (list (cons 'x (Tint 3)))))
247                                   (Tstr "three"))
248                 )))
249
250  (test-assert "loop index/revindex"
251               
252               (and
253                (let* ( (source "{% for i in range(1,3) %}{{loop.index}}{% endfor %}" ))
254                  (tval-equal? (Tstr (from-string source)) (Tstr "123")))
255                (let* ( (source "{% for i in range(1,3) %}{{loop.index0}}{% endfor %}" ))
256                  (tval-equal? (Tstr (from-string source)) (Tstr "012")))
257                (let* ( (source "{% for i in range(1,3) %}{{loop.revindex}}{% endfor %}" ))
258                  (tval-equal? (Tstr (from-string source)) (Tstr "321")))
259                (let* ( (source "{% for i in range(1,3) %}{{loop.revindex0}}{% endfor %}" ))
260                  (tval-equal? (Tstr (from-string source)) (Tstr "210")))
261
262               ))
263
264  (test-assert "loop cycle"
265               (let* ( (source "{% for i in range(1,3) %}{{loop.cycle(\"foo\",\"bar\",\"test\")}}{% endfor %}" ))
266                 (tval-equal? (Tstr (from-string source)) (Tstr "foobartest"))))
267
268  (test-assert "loop first"
269               (let* ( (source "{% for i in range(1,3) %}{{loop.first}}{% endfor %}" ))
270                 (tval-equal? (Tstr (from-string source)) (Tstr "truefalsefalse"))))
271
272  (test-assert "loop last"
273               (let* ( (source "{% for i in range(1,3) %}{{loop.last}}{% endfor %}" ))
274                 (tval-equal? (Tstr (from-string source)) (Tstr "falsefalsetrue"))))
275
276  (test-assert "loop length"
277               (let* ( (source "{% for i in range(1,3) %}{{loop.length}}{% endfor %}" ))
278                 (tval-equal? (Tstr (from-string source)) (Tstr "333"))))
279
280  (test-assert "in"
281               (let* ( (source "{{ 'aa' in ['bb', 'aa', 'cc'] }}" ))
282                 (tval-equal? (Tstr (from-string source)) (Tstr "true"))))
283
284
285  (test-assert "is"
286               (let* ( (source "{{ 6 is divisibleby 3 }}" ))
287                 (tval-equal? (Tstr (from-string source)) (Tstr "true"))))
288
289  (test-assert "is"
290               (let* ( (source "{{ 6 is divisibleby(3) }}" ))
291                 (tval-equal? (Tstr (from-string source)) (Tstr "true"))))
292
293  (test-assert "set"
294               (let* ( (source "{% set x = 'aa' %}{{ x }}"  ))
295                 (tval-equal? (Tstr (from-string source)) (Tstr "aa"))))
296
297  (test-assert "set/with"
298               (let* ( (source "{% set x = 'aa' %}{% with x = 'bb', y = 'cc' %}{{ x }}{{ y }}{% endwith %}{{ x }}{{ y }}"  ))
299                 (tval-equal? (Tstr (from-string source)) (Tstr "bbccaa"))))
300
301  (test-assert "defined"
302               (let* ( (source "{% set obj = { age:10, name: 'aa' } %} {{ obj.age is defined }}"  ))
303                 (tval-equal? (Tstr (from-string source)) (Tstr " true"))))
304
305  (test-assert "defined"
306               (let* ( (source "{% set obj = { age:10, name: 'aa' } %} {{ obj['name'] is defined }}"  ))
307                 (tval-equal? (Tstr (from-string source)) (Tstr " true"))))
308
309  (test-assert "extends"
310               (tval-equal? (Tstr (from-file "extends.tmpl" 
311                                             env: (template-std-env search-path: '("tests/tmpl"))))
312                            (Tstr "extended\n\n")))
313
314  (test-assert "include"
315               (tval-equal? (Tstr (from-file "include.tmpl" 
316                                             env: (template-std-env search-path: '("tests/tmpl"))))
317                            (Tstr "this is included\n\n")))
318 
319  (let ((macro-three-words #<<EOF
320{% macro three_words(one,two,three) %}
321{{one}} {{two}} {{three}}{{caller (' by','michael','jackson')}}
322{% endmacro %}
323EOF
324))
325       
326  (test-assert "macro"
327               (tval-equal? 
328                  (Tstr (from-string
329                         (string-append macro-three-words
330                                        "{{ three_words(\"this\", \"is\", \"it!\") }}")))
331                  (Tstr "\nthis is it!\n")))
332       
333  (test-assert "caller"
334               (tval-equal? 
335                  (Tstr (from-string
336                         (string-append macro-three-words
337                                        (string-append
338                                         "{% call(a,b,c) three_words('this', 'is', 'it!') %}"
339                                         "{{a}} {{b}} {{c}}";
340                                         "{% endcall %}")
341                                        )))
342                  (Tstr "\nthis is it! by michael jackson\n")))
343
344)
345
346   (test-assert "filter"
347       (tval-equal? 
348         (Tstr (from-string "{% filter upper %}must be upper{% endfilter %}"))
349         (Tstr "MUST BE UPPER")))
350
351
352   (test-assert "set"
353       (tval-equal? 
354         (Tstr (from-string "{% set x = \"test\" %}{{x}}"))
355         (Tstr "test")))
356
357   (test-assert "make-lexer-table"
358               (let* ((lexer-table (make-lexer-table begin-expand: "%{{" end-expand: "%}}" compile: #f))
359                      (env (template-std-env lexer-table: lexer-table))
360                      (script "<script>alert(1)</script>")
361                      (output (from-string "%{{danger%}}" 
362                                           env: env
363                                           models: (list (cons 'danger (Tstr script)))))
364                      )
365                 (tval-equal? (Tstr output) (op-escape-html (Tstr script) kwargs))))
366
367   (test-assert "make-lexer-table (compiled)"
368               (let* ((lexer-table (make-lexer-table begin-expand: "%{{" end-expand: "%}}" compile: #t))
369                      (env (template-std-env lexer-table: lexer-table))
370                      (script "<script>alert(1)</script>")
371                      (output (from-string "%{{danger%}}" 
372                                           env: env
373                                           models: (list (cons 'danger (Tstr script)))))
374                      )
375                 (tval-equal? (Tstr output) (op-escape-html (Tstr script) kwargs))))
376
377     
378)
Note: See TracBrowser for help on using the repository browser.