← Back to branch summary

~ubuntu-branches/ubuntu/hardy/uim/hardy

« back to all changes in this revision

Viewing changes to sigscheme/test/test-quote.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2007-04-21 03:46:09 UTC
  • mfrom: (1.1.6 upstream)
  • Revision ID: james.westby@ubuntu.com-20070421034609-gpcurkutp8vaysqj
Tags: 1:1.4.1-3
* Switch to dh_gtkmodules for the gtk 2.10 transition (Closes:
  #419318)
  - debian/control: Add ${misc:Depends} and remove libgtk2.0-bin on
    uim-gtk2.0.
  - debian/uim-gtk2.0.post{inst,rm}: Removed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
sigscheme/test/test-quote.scm
 
1
;;  Filename : test-quote.scm
 
2
;;  About    : unit test for quote and quasiquote
 
3
;;
 
4
;;  Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
 
5
;;  Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
 
6
;;
 
7
;;  All rights reserved.
 
8
;;
 
9
;;  Redistribution and use in source and binary forms, with or without
 
10
;;  modification, are permitted provided that the following conditions
 
11
;;  are met:
 
12
;;
 
13
;;  1. Redistributions of source code must retain the above copyright
 
14
;;     notice, this list of conditions and the following disclaimer.
 
15
;;  2. Redistributions in binary form must reproduce the above copyright
 
16
;;     notice, this list of conditions and the following disclaimer in the
 
17
;;     documentation and/or other materials provided with the distribution.
 
18
;;  3. Neither the name of authors nor the names of its contributors
 
19
;;     may be used to endorse or promote products derived from this software
 
20
;;     without specific prior written permission.
 
21
;;
 
22
;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 
23
;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
24
;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
25
;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 
26
;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
27
;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 
28
;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 
29
;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 
30
;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 
31
;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 
32
;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
33
 
 
34
(load "./test/unittest.scm")
 
35
 
 
36
(if (not (symbol-bound? 'quasiquote))
 
37
    (test-skip "R5RS quasiquote is not enabled"))
 
38
 
 
39
(define tn test-name)
 
40
(define *test-track-progress* #f)
 
41
 
 
42
(tn "quote")
 
43
(assert-equal? (tn) #f  '#f)
 
44
(assert-equal? (tn) #t  '#t)
 
45
(assert-equal? (tn) #\a '#\a)
 
46
(assert-equal? (tn) #\a '#\a)
 
47
(assert-equal? (tn) 1   '1)
 
48
(assert-equal? (tn) -1  '-1)
 
49
(assert-equal? (tn) 1   '#b1)
 
50
(assert-equal? (tn) 1   '#o1)
 
51
(assert-equal? (tn) 1   '#d1)
 
52
(assert-equal? (tn) 1   '#x1)
 
53
(assert-equal? (tn) "a" '"a")
 
54
(assert-equal? (tn) (string->symbol "sym") 'sym)
 
55
(assert-equal? (tn) (quote sym) 'sym)
 
56
(assert-equal? (tn) (quote (quote sym)) ''sym)
 
57
(assert-equal? (tn) (quote (quote (quote sym))) '''sym)
 
58
(assert-equal? (tn) (list)     '())
 
59
(assert-equal? (tn) (list 1)   '(1))
 
60
(assert-equal? (tn) (vector)   '#())
 
61
(assert-equal? (tn) (vector 1) '#(1))
 
62
 
 
63
 
 
64
(assert-true "quasiquote check #1" (equal? '(1 2 3) `(1 2 3)))
 
65
(assert-true "quasiquote check #2" (equal? '(5) `(,(+ 2 3))))
 
66
(assert-true "unquote check" (equal? `(1 2 3) `(1 ,(+ 1 1) ,(+ 1 2))))
 
67
(assert-true "unquote-splicing check" (equal? `(1 2 3) `(1 ,@(cdr '(1 2)) 3)))
 
68
(assert-true "mixed check" (equal? '(a 3 c 7 8 9) `(a ,(+ 1 2) c ,@(cdr '(6 7 8 9)))))
 
69
(assert-equal? "nested quasiquote check #1"
 
70
               '(a `(b c ,() 0) 1)
 
71
               `(a `(b c ,(,@() ,@()) 0) 1))
 
72
 
 
73
(assert-equal? "nested quasiquote check #2"
 
74
               '(0 1)
 
75
               `(0 . ,(list 1)))
 
76
 
 
77
(assert-equal? "nested quasiquote check #3"
 
78
               '(0 . 1)
 
79
               `(0 . ,'1))
 
80
 
 
81
(assert-equal? "nested quasiquote check #4"
 
82
               '(0 quasiquote (unquote 1))
 
83
               `(0 . `,,(+ 1)))
 
84
 
 
85
(assert-true "vector quasiquote check #1"
 
86
        (equal?
 
87
         '#(#(a b c d) e)
 
88
         `#(,@() #(a ,@(list 'b 'c) d) e)))
 
89
(assert-equal? "vector quasiquote check #2" '(1 . #(2 3)) `(1 . #(,(+ 1 1) 3)))
 
90
(assert-equal? "vector quasiquote check #3"
 
91
               '(0 . #(1 2 3 4 5 6))
 
92
               `(0 . #(1 ,2 ,@(list 3 4) 5 ,6 ,@())))
 
93
(assert-equal? "vector quasiquote check #3"
 
94
               '#(a b)
 
95
               `#(,@(list 'a 'b)))
 
96
 
 
97
(tn "quasiquote reference test of R5RS")
 
98
(if (not (symbol-bound? 'sqrt))
 
99
    (eval '(define sqrt
 
100
             (lambda (x)
 
101
               (cdr (assv x '((4  . 2)
 
102
                              (9  . 3)
 
103
                              (16 . 4))))))
 
104
          (interaction-environment)))
 
105
(assert-equal? (tn)
 
106
               '(list 3 4)
 
107
               `(list ,(+ 1 2) 4))
 
108
(assert-equal? (tn)
 
109
               '(list a (quote a))
 
110
               (let ((name 'a)) `(list ,name ',name)))
 
111
(assert-equal? (tn)
 
112
               '(a 3 4 5 6 b)
 
113
               `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
 
114
;; Commented out since the test seems to wrong. Even if the interpretation for
 
115
;; the quote after foo (foo') may varied by implementation, at least the
 
116
;; quasiquote before foo (`foo) must be remained.
 
117
;;
 
118
;; SigScheme: (((quasiquote foo') 7) . cons)
 
119
;; Gauche:    ((`foo '7) . cons)
 
120
;; Guile:     (((quasiquote foo') 7) . cons)
 
121
;; Bigloo:    (((quasiquote foo') 7) . cons)
 
122
;; Scheme48:  (((quasiquote foo) '7) . cons)
 
123
;; SCM:       (((quasiquote foo\') 7) . cons)
 
124
;; PLT:       read: illegal use of backquote
 
125
;;(assert-equal? (tn)
 
126
;;               '((foo 7) . cons)
 
127
;;               `((`foo' ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
 
128
(assert-equal? (tn)
 
129
               '#(10 5 2 4 3 8)
 
130
               `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8))
 
131
(assert-equal? (tn)
 
132
               '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
 
133
               `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
 
134
(assert-equal? (tn)
 
135
               '(a `(b ,x ,'y d) e)
 
136
               (let ((name1 'x)
 
137
                     (name2 'y))
 
138
                 `(a `(b ,,name1 ,',name2 d) e)))
 
139
(assert-equal? (tn)
 
140
               '(list 3 4)
 
141
               (quasiquote (list (unquote (+ 1 2)) 4)))
 
142
(assert-equal? (tn)
 
143
               '`(list ,(+ 1 2) 4)
 
144
               '(quasiquote (list (unquote (+ 1 2)) 4)))
 
145
 
 
146
(tn "quasiquote valid form")
 
147
(assert-equal? (tn) ''1      `'1)
 
148
(assert-equal? (tn) '`1      ``1)
 
149
(assert-equal? (tn) 1        `,1)
 
150
(assert-equal? (tn) ''1      `',1)
 
151
(assert-equal? (tn) '(quote 1)      `'1)
 
152
(assert-equal? (tn) '(quasiquote 1) ``1)
 
153
(assert-equal? (tn) '(quote 1)      `',1)
 
154
(assert-equal? (tn) '()      `())
 
155
(assert-equal? (tn) '('1)    `('1))
 
156
(assert-equal? (tn) '(`1)    `(`1))
 
157
(assert-equal? (tn) '(1)     `(,1))
 
158
(assert-equal? (tn) '('1)    `(',1))
 
159
(assert-equal? (tn) '(1)     `(,'1))
 
160
(assert-equal? (tn) '(1)     `(,`1))
 
161
(assert-equal? (tn) '((quote 1))      `('1))
 
162
(assert-equal? (tn) '((quasiquote 1)) `(`1))
 
163
(assert-equal? (tn) '(1)              `(,1))
 
164
(assert-equal? (tn) '((quote 1))      `(',1))
 
165
(assert-equal? (tn) '#()      `#())
 
166
(assert-equal? (tn) '#('1)    `#('1))
 
167
(assert-equal? (tn) '#(`1)    `#(`1))
 
168
(assert-equal? (tn) '#(1)     `#(,1))
 
169
(assert-equal? (tn) '#('1)    `#(',1))
 
170
(assert-equal? (tn) '#(1)     `#(,'1))
 
171
(assert-equal? (tn) '#(1)     `#(,`1))
 
172
 
 
173
(tn "quasiquote nested")
 
174
(assert-equal? (tn)
 
175
               '((quasiquote q) q)
 
176
               `(`q ,`q))
 
177
(assert-equal? (tn)
 
178
               '((quasiquote q) (q (quasiquote q)))
 
179
               `(`q ,`(q `q)))
 
180
(assert-equal? (tn)
 
181
               '((quasiquote q) (q q))
 
182
               `(`q ,`(q ,`q)))
 
183
(assert-equal? (tn)
 
184
               '((quasiquote q) (q q (quasiquote q)))
 
185
               `(`q ,`(q ,`q `q)))
 
186
(assert-equal? (tn)
 
187
               '((quasiquote q) (q q (quasiquote (unquote q))))
 
188
               `(`q ,`(q ,`q `,q)))
 
189
(assert-equal? (tn)
 
190
               '((quasiquote q) (q q (quasiquote (unquote (quasiquote q)))))
 
191
               `(`q ,`(q ,`q `,`q)))
 
192
(assert-equal? (tn)
 
193
               '((quasiquote q) (q q (quasiquote (unquote q))))
 
194
               `(`q ,`(q ,`q `,,`q)))
 
195
 
 
196
(tn "unquote-splicing nested")
 
197
(assert-equal? (tn) '(1 2)
 
198
               `(,@(list 1 2)))
 
199
(assert-equal? (tn) '(quasiquote ((unquote-splicing (list 1 2))))
 
200
               ``(,@(list 1 2)))
 
201
(assert-equal? (tn) '(quasiquote (unquote (1 2)))
 
202
               ``,(,@(list 1 2)))
 
203
 
 
204
;; These tests show implementation-dependent behavior. But I believe that
 
205
;; SigScheme's implementation is conforming to following R5RS specification
 
206
;; better. Let me know if I'm misunderstanding.  -- YamaKen 2006-06-25
 
207
;;
 
208
;; R5RS: 7.1.4 Quasiquotations
 
209
;;
 
210
;; In <quasiquotation>s, a <list qq template D> can sometimes be confused with
 
211
;; either an <unquotation D> or a <splicing unquotation D>. The interpretation
 
212
;; as an <unquotation> or <splicing unquotation D> takes precedence.
 
213
 
 
214
;; Guile, Gauche, Bigloo, SCM
 
215
;;(assert-equal? (tn)
 
216
;;               '(quasiquote ((unquote (unquote-splicing (list 1 2)))))
 
217
;;               ``(,,@(list 1 2)))
 
218
;;(assert-equal? (tn)
 
219
;;               '(quasiquote ((unquote (unquote-splicing (list 1 2)))))
 
220
;;               (quasiquote
 
221
;;                (quasiquote
 
222
;;                 ((unquote (unquote-splicing (list 1 2)))))))
 
223
;; SigScheme, Scheme48
 
224
(assert-equal? (tn)
 
225
               '(quasiquote ((unquote 1 2)))
 
226
               ``(,,@(list 1 2)))
 
227
(assert-equal? (tn)
 
228
               '(quasiquote ((unquote 1 2)))
 
229
               (quasiquote
 
230
                (quasiquote
 
231
                 ((unquote (unquote-splicing (list 1 2)))))))
 
232
 
 
233
(assert-equal? (tn) '(quasiquote (list 1 2 (unquote-splicing (list 1 2))))
 
234
               ``(list 1 2 ,@(list 1 2)))
 
235
;; Guile, Gauche, Bigloo, SCM
 
236
;;(assert-equal? (tn)
 
237
;;               '(quasiquote
 
238
;;                 (list 1 2 (unquote (unquote-splicing (list 1 2)))))
 
239
;;               ``(list 1 2 ,,@(list 1 2)))
 
240
;;(assert-equal? (tn)
 
241
;;               '(quasiquote
 
242
;;                 (list 1 2 (unquote (unquote-splicing (list 1 2)))))
 
243
;;               (quasiquote
 
244
;;                (quasiquote
 
245
;;                 (list 1 2 (unquote (unquote-splicing (list 1 2)))))))
 
246
;; SigScheme, Scheme48
 
247
(assert-equal? (tn)
 
248
               '(quasiquote (list 1 2 (unquote 1 2)))
 
249
               ``(list 1 2 ,,@(list 1 2)))
 
250
(assert-equal? (tn)
 
251
               '(quasiquote (list 1 2 (unquote 1 2)))
 
252
               (quasiquote
 
253
                (quasiquote
 
254
                 (list 1 2 (unquote (unquote-splicing (list 1 2)))))))
 
255
 
 
256
;; Guile, Gauche, Bigloo, SCM
 
257
;;(assert-equal? (tn)
 
258
;;               '((+ 1 2)
 
259
;;                 3
 
260
;;                 (list (+ 1 2) 3 1 2)
 
261
;;                 `(list (+ 1 2) ,(+ 1 2) ,@(list 1 2))
 
262
;;                 `(list ,(+ 1 2) ,3 ,,@(list 1 2)))
 
263
;;               `((+ 1 2)
 
264
;;                 ,(+ 1 2)
 
265
;;                 (list (+ 1 2) ,(+ 1 2) ,@(list 1 2))
 
266
;;                 `(list (+ 1 2) ,(+ 1 2) ,@(list 1 2))
 
267
;;                 `(list ,(+ 1 2) ,,(+ 1 2) ,,@(list 1 2))))
 
268
;; SigScheme, Scheme48
 
269
(assert-equal? (tn)
 
270
               '((+ 1 2)
 
271
                 3
 
272
                 (list (+ 1 2) 3 1 2)
 
273
                 `(list (+ 1 2) ,(+ 1 2) ,@(list 1 2))
 
274
                 `(list ,(+ 1 2) ,3 (unquote 1 2)))
 
275
               `((+ 1 2)
 
276
                 ,(+ 1 2)
 
277
                 (list (+ 1 2) ,(+ 1 2) ,@(list 1 2))
 
278
                 `(list (+ 1 2) ,(+ 1 2) ,@(list 1 2))
 
279
                 `(list ,(+ 1 2) ,,(+ 1 2) ,,@(list 1 2))))
 
280
 
 
281
 
 
282
;; R5RS allows these forms to be an error
 
283
(tn "quasiquote implementation-dependent form")
 
284
(if (provided? "sigscheme")
 
285
    (begin
 
286
      (assert-error  (tn) (lambda () `((quasiquote))))
 
287
      (assert-error  (tn) (lambda () `((quasiquote . 0))))
 
288
      (assert-error  (tn) (lambda () `((quasiquote 0 1))))
 
289
      (assert-error  (tn) (lambda () `((quasiquote 0 . 1))))
 
290
      (assert-error  (tn) (lambda () `(0 quasiquote)))
 
291
      (assert-error  (tn) (lambda () `(0 . (quasiquote))))
 
292
      (assert-error  (tn) (lambda () `(0 quasiquote 2 3)))
 
293
      (assert-error  (tn) (lambda () `(0 . (quasiquote 2 3))))
 
294
      (assert-error  (tn) (lambda () `(0 quasiquote 2 3 4)))
 
295
      (assert-error  (tn) (lambda () `(0 . (quasiquote 2 3 4))))
 
296
      (assert-error  (tn) (lambda () `(0 quasiquote . 0)))
 
297
      (assert-error  (tn) (lambda () `(0 . (quasiquote . 0))))
 
298
      (assert-error  (tn) (lambda () `(0 quasiquote 2 3 . 0)))
 
299
      (assert-error  (tn) (lambda () `(0 . (quasiquote 2 3 . 0))))
 
300
      (assert-error  (tn) (lambda () `(0 quasiquote 2 3 4 . 0)))
 
301
      (assert-error  (tn) (lambda () `(0 . (quasiquote 2 3 4 . 0))))))
 
302
(tn "unquote implementation-dependent form")
 
303
(if (provided? "sigscheme")
 
304
    (begin
 
305
      (assert-error  (tn) (lambda () `((unquote))))
 
306
      (assert-error  (tn) (lambda () `((unquote . 0))))
 
307
      (assert-error  (tn) (lambda () `((unquote 0 1))))
 
308
      (assert-error  (tn) (lambda () `((unquote 0 . 1))))
 
309
      (assert-error  (tn) (lambda () `(0 unquote)))
 
310
      (assert-error  (tn) (lambda () `(0 . (unquote))))
 
311
      (assert-error  (tn) (lambda () `(0 unquote 2 3)))
 
312
      (assert-error  (tn) (lambda () `(0 . (unquote 2 3))))
 
313
      (assert-error  (tn) (lambda () `(0 unquote 2 3 4)))
 
314
      (assert-error  (tn) (lambda () `(0 . (unquote 2 3 4))))
 
315
      (assert-error  (tn) (lambda () `(0 unquote . 0)))
 
316
      (assert-error  (tn) (lambda () `(0 . (unquote . 0))))
 
317
      (assert-error  (tn) (lambda () `(0 unquote 2 3 . 0)))
 
318
      (assert-error  (tn) (lambda () `(0 . (unquote 2 3 . 0))))
 
319
      (assert-error  (tn) (lambda () `(0 unquote 2 3 4 . 0)))
 
320
      (assert-error  (tn) (lambda () `(0 . (unquote 2 3 4 . 0))))))
 
321
(tn "unquote-splicing implementation-dependent form")
 
322
(if (provided? "sigscheme")
 
323
    (begin
 
324
      (assert-error  (tn) (lambda () `(0 unquote-splicing)))
 
325
      (assert-error  (tn) (lambda () `(0 . (unquote-splicing))))
 
326
      (assert-error  (tn) (lambda () `(0 unquote-splicing 2 3)))
 
327
      (assert-error  (tn) (lambda () `(0 . (unquote-splicing 2 3))))
 
328
      (assert-error  (tn) (lambda () `(0 unquote-splicing 2 3 4)))
 
329
      (assert-error  (tn) (lambda () `(0 . (unquote-splicing 2 3 4))))
 
330
      (assert-error  (tn) (lambda () `(0 unquote-splicing . 0)))
 
331
      (assert-error  (tn) (lambda () `(0 . (unquote-splicing . 0))))
 
332
      (assert-error  (tn) (lambda () `(0 unquote-splicing 2 3 . 0)))
 
333
      (assert-error  (tn) (lambda () `(0 . (unquote-splicing 2 3 . 0))))
 
334
      (assert-error  (tn) (lambda () `(0 unquote-splicing 2 3 4 . 0)))
 
335
      (assert-error  (tn) (lambda () `(0 . (unquote-splicing 2 3 4 . 0))))
 
336
      (assert-error  (tn) (lambda () `((unquote-splicing))))
 
337
      (assert-error  (tn) (lambda () `((unquote-splicing . 0))))
 
338
      (assert-error  (tn) (lambda () `((unquote-splicing 0 1))))
 
339
      (assert-error  (tn) (lambda () `((unquote-splicing 0 . 1))))))
 
340
 
 
341
(tn "quasiquote dotted list")
 
342
(assert-equal? (tn) '(0 . '1)         `(0 . '1))
 
343
(assert-equal? (tn) '(0 . `1)         `(0 . `1))
 
344
(assert-equal? (tn) '(0 . 1)          `(0 . ,1))
 
345
(assert-equal? (tn) '(0 . (quote 1))  `(0 . '1))
 
346
(assert-equal? (tn) '(0 . (quasiquote 1)) `(0 . `1))
 
347
(assert-equal? (tn) '(0 . #(1))       `(0 . ,'#(1)))
 
348
(assert-equal? (tn) '(0 . #(1))       `(0 . ,`#(1)))
 
349
(assert-equal? (tn) '(0 . #(1 3))     `(0 . ,`#(1 ,(+ 1 2))))
 
350
(assert-equal? (tn) '(0 . #(1 -1 -2)) `(0 . ,`#(1 ,@(list (- 1) (- 2)))))
 
351
(assert-error  (tn) (lambda ()        `(0 . ,@())))
 
352
(assert-error  (tn) (lambda ()        `(0 . ,@(list))))
 
353
(assert-error  (tn) (lambda ()        `(0 . ,@(list 1))))
 
354
(assert-error  (tn) (lambda ()        `(0 . ,@(list 1 2))))
 
355
(assert-error  (tn) (lambda ()        `(0 . ,@(list 1 2 3))))
 
356
(assert-error  (tn) (lambda ()        `(0 . ,@#t)))
 
357
(assert-error  (tn) (lambda ()        `(0 . ,@1)))
 
358
(assert-error  (tn) (lambda ()        `(0 . ,@#\a)))
 
359
(assert-error  (tn) (lambda ()        `(0 . ,@"str")))
 
360
(assert-error  (tn) (lambda ()        `(0 . ,@'sym)))
 
361
(assert-error  (tn) (lambda ()        `(0 . ,@sym)))
 
362
(assert-error  (tn) (lambda ()        `(0 . ,@var)))
 
363
(assert-error  (tn) (lambda ()        `(0 . ,@(lambda () #f))))
 
364
(assert-error  (tn) (lambda ()        `(0 . ,@(+ 1 2))))
 
365
(assert-error  (tn) (lambda ()        `(0 . ,@#(1 2))))
 
366
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing ()))))
 
367
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing (list)))))
 
368
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing (list 1)))))
 
369
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing (list 1 2)))))
 
370
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing (list 1 2 3)))))
 
371
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing #t))))
 
372
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing 1))))
 
373
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing #\a))))
 
374
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing "str"))))
 
375
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing 'sym))))
 
376
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing sym))))
 
377
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing var))))
 
378
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing (lambda () #f)))))
 
379
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing (+ 1 2)))))
 
380
(assert-error  (tn) (lambda ()        `(0 . (unquote-splicing #(1 2)))))
 
381
 
 
382
(tn "unquote valid form")
 
383
(assert-equal? (tn) 1     `,1)
 
384
(assert-equal? (tn) ',1   ',1)
 
385
(assert-equal? (tn) '(quasiquote 1)           ``1)
 
386
(assert-equal? (tn) '(quasiquote (unquote 1)) ``,1)
 
387
(assert-equal? (tn) '(quasiquote (unquote 1)) ``,,1)
 
388
(assert-equal? (tn) '(quasiquote (+ 1 2))           ``(+ 1 2))
 
389
(assert-equal? (tn) '(quasiquote (unquote (+ 1 2))) ``,(+ 1 2))
 
390
(assert-equal? (tn) '(quasiquote (unquote 3))       ``,,(+ 1 2))
 
391
(assert-equal? (tn) '(quasiquote (list 1 2 (+ 1 2)))
 
392
               ``(list 1 2 (+ 1 2)))
 
393
(assert-equal? (tn) '(quasiquote (unquote (list 1 2 (+ 1 2))))
 
394
               ``,(list 1 2 (+ 1 2)))
 
395
(assert-equal? (tn) '(quasiquote (unquote (1 2 3)))
 
396
               ``,,(list 1 2 (+ 1 2)))
 
397
(assert-equal? (tn) '(quasiquote (list 1 2 (unquote (+ 1 2))))
 
398
               ``(list 1 2 ,(+ 1 2)))
 
399
(assert-equal? (tn) '(quasiquote (list 1 2 (unquote 3)))
 
400
               ``(list 1 2 ,,(+ 1 2)))
 
401
(assert-equal? (tn) '(quasiquote (list 1 2))           ``(list 1 2))
 
402
(assert-equal? (tn) '(quasiquote (unquote (list 1 2))) ``,(list 1 2))
 
403
(assert-equal? (tn) '(quasiquote (unquote (1 2)))      ``,,(list 1 2))
 
404
(assert-equal? (tn) 1 `,`,1)
 
405
(assert-equal? (tn) 3 `,(+ 1 2))
 
406
(assert-equal? (tn) ',(+ 1 2) ',(+ 1 2))
 
407
(assert-equal? (tn) '(+ 1 2) (cadr ',(+ 1 2)))
 
408
(assert-equal? (tn) '(quasiquote (unquote 3)) ``,,(+ 1 2))
 
409
(assert-equal? (tn) 3     `,`,(+ 1 2))
 
410
;; list
 
411
(assert-equal? (tn) '(1)  `(,1))
 
412
(assert-equal? (tn) '(quasiquote ((unquote 1))) ``(,,1))
 
413
(assert-equal? (tn) '(1)  `(,`,1))
 
414
(assert-equal? (tn)
 
415
               '(quasiquote (quasiquote ((unquote (unquote 1)))))
 
416
               ```(,,,1))
 
417
(assert-equal? (tn) '(3)  `(,(+ 1 2)))
 
418
(assert-equal? (tn) '(quasiquote ((unquote 3))) ``(,,(+ 1 2)))
 
419
;; vector
 
420
(assert-equal? (tn) '#(1)  `#(,1))
 
421
(assert-equal? (tn) '(quasiquote #((unquote 1))) ``#(,,1))
 
422
(assert-equal? (tn) '#(1)  `#(,`,1))
 
423
(assert-equal? (tn)
 
424
               '(quasiquote (quasiquote #((unquote (unquote 1)))))
 
425
               ```#(,,,1))
 
426
(assert-equal? (tn) '#(3)  `#(,(+ 1 2)))
 
427
(assert-equal? (tn) '(quasiquote #((unquote 3))) ``#(,,(+ 1 2)))
 
428
 
 
429
(tn "unquote invalid form")
 
430
(assert-error (tn) (lambda () ,1))
 
431
(assert-error (tn) (lambda () ,,1))
 
432
(assert-error (tn) (lambda () `,,1))
 
433
(assert-error (tn) (lambda () ,(+ 1 2)))
 
434
(assert-error (tn) (lambda () ,,(+ 1 2)))
 
435
(assert-error (tn) (lambda () `,,(+ 1 2)))
 
436
(assert-error (tn) (lambda () `(,,1)))
 
437
(assert-error (tn) (lambda () ``(,,,1)))
 
438
(assert-error (tn) (lambda () `(,,(+ 1 2))))
 
439
(assert-error (tn) (lambda () ``(,,,(+ 1 2))))
 
440
(assert-error (tn) (lambda () `#(,,1)))
 
441
(assert-error (tn) (lambda () ``#(,,,1)))
 
442
(assert-error (tn) (lambda () `#(,,(+ 1 2))))
 
443
(assert-error (tn) (lambda () ``#(,,,(+ 1 2))))
 
444
 
 
445
(tn "unquote-splicing valid form")
 
446
(assert-equal? (tn) '()      `(,@()))
 
447
(assert-equal? (tn) '()      `(,@() ,@()))
 
448
(assert-equal? (tn) '()      `(,@() ,@() ,@()))
 
449
(assert-equal? (tn) '(0)     `(0 ,@()))
 
450
(assert-equal? (tn) '(1)     `(,@() 1))
 
451
(assert-equal? (tn) '(0 1)   `(0 ,@() 1))
 
452
(assert-equal? (tn) '()      `(,@(list)))
 
453
(assert-equal? (tn) '(1)     `(,@(list 1)))
 
454
(assert-equal? (tn) '(1 2)   `(,@(list 1 2)))
 
455
(assert-equal? (tn) '(1 2 3) `(,@(list 1 2 3)))
 
456
(assert-equal? (tn) '(0 1 2 3) `(0 ,@(list 1 2 3)))
 
457
(assert-equal? (tn) '(1 2 3 4) `(,@(list 1 2 3) 4))
 
458
(assert-equal? (tn) '(0 1 2 3 4) `(0 ,@(list 1 2 3) 4))
 
459
(assert-equal? (tn) '(1 2 3) `(,@((lambda () '(1 2 3)))))
 
460
(assert-equal? (tn) '(0 1 2 3 4) `(0 ,@((lambda () '(1 2 3))) 4))
 
461
(assert-equal? (tn) '#()      `#(,@()))
 
462
(assert-equal? (tn) '#()      `#(,@() ,@()))
 
463
(assert-equal? (tn) '#()      `#(,@() ,@() ,@()))
 
464
(assert-equal? (tn) '#(0)     `#(0 ,@()))
 
465
(assert-equal? (tn) '#(1)     `#(,@() 1))
 
466
(assert-equal? (tn) '#(0 1)   `#(0 ,@() 1))
 
467
;; negative growth for vectran
 
468
(assert-equal? (tn) '#(0 1)   `#(0 ,@() ,@() ,@() ,@() 1 ,@()))
 
469
(assert-equal? (tn) '#(1 2 3) `#(,@((lambda () '(1 2 3)))))
 
470
(assert-equal? (tn) '#(0 1 2 3 4) `#(0 ,@((lambda () '(1 2 3))) 4))
 
471
 
 
472
(tn "unquote-splicing invalid form")
 
473
(define sym 'sym)
 
474
(define var 3)
 
475
(assert-error (tn) (lambda () `,@()))
 
476
(assert-error (tn) (lambda () `,@(list)))
 
477
(assert-error (tn) (lambda () `,@(list 1)))
 
478
(assert-error (tn) (lambda () `,@(list 1 2)))
 
479
(assert-error (tn) (lambda () `,@(list 1 2 3)))
 
480
(assert-error (tn) (lambda () `(,@(,@()))))
 
481
(assert-error (tn) (lambda () `(,@(`,@()))))
 
482
(assert-error (tn) (lambda () `(,@(,1))))
 
483
(assert-error (tn) (lambda () `(,@(`(,,1)))))
 
484
(assert-error (tn) (lambda () `#(,@(,@()))))
 
485
(assert-error (tn) (lambda () `#(,@(`,@()))))
 
486
(assert-error (tn) (lambda () `#(,@(,1))))
 
487
(assert-error (tn) (lambda () `#(,@(`(,,1)))))
 
488
(assert-error (tn) (lambda () `(0 ,@((lambda () '(1 2 . 3))) 4)))
 
489
(assert-error (tn) (lambda () `#(0 ,@((lambda () '(1 2 . 3))) 4)))
 
490
(assert-error (tn) (lambda () `,@#t))
 
491
(assert-error (tn) (lambda () `,@1))
 
492
(assert-error (tn) (lambda () `,@1))
 
493
(assert-error (tn) (lambda () `,@#\a))
 
494
(assert-error (tn) (lambda () `,@"str"))
 
495
(assert-error (tn) (lambda () `,@'sym))
 
496
(assert-error (tn) (lambda () `,@sym))
 
497
(assert-error (tn) (lambda () `,@var))
 
498
(assert-error (tn) (lambda () `,@(lambda () #f)))
 
499
(assert-error (tn) (lambda () `,@(+ 1 2)))
 
500
(assert-error (tn) (lambda () `,@#(1 2)))
 
501
(assert-error (tn) (lambda () `(,@#t)))
 
502
(assert-error (tn) (lambda () `(,@1)))
 
503
(assert-error (tn) (lambda () `(,@#\a)))
 
504
(assert-error (tn) (lambda () `(,@"str")))
 
505
(assert-error (tn) (lambda () `(,@'sym)))
 
506
(assert-error (tn) (lambda () `(,@sym)))
 
507
(assert-error (tn) (lambda () `(,@var)))
 
508
(assert-error (tn) (lambda () `(,@(lambda () #f))))
 
509
(assert-error (tn) (lambda () `(,@(+ 1 2))))
 
510
(assert-error (tn) (lambda () `(,@#(1 2))))
 
511
 
 
512
(total-report)