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

Last change on this file since 31371 was 31371, checked in by Ivan Raikov, 7 years ago

ersatz release 1.13

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