← Back to branch summary

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

« back to all changes in this revision

Viewing changes to sigscheme/test/test-list.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-list.scm
 
1
#! /usr/bin/env sscm -C UTF-8
 
2
;; -*- buffer-file-coding-system: utf-8 -*-
 
3
 
 
4
;;  Filename : test-list.scm
 
5
;;  About    : unit test for list operations
 
6
;;
 
7
;;  Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
 
8
;;  Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
 
9
;;
 
10
;;  All rights reserved.
 
11
;;
 
12
;;  Redistribution and use in source and binary forms, with or without
 
13
;;  modification, are permitted provided that the following conditions
 
14
;;  are met:
 
15
;;
 
16
;;  1. Redistributions of source code must retain the above copyright
 
17
;;     notice, this list of conditions and the following disclaimer.
 
18
;;  2. Redistributions in binary form must reproduce the above copyright
 
19
;;     notice, this list of conditions and the following disclaimer in the
 
20
;;     documentation and/or other materials provided with the distribution.
 
21
;;  3. Neither the name of authors nor the names of its contributors
 
22
;;     may be used to endorse or promote products derived from this software
 
23
;;     without specific prior written permission.
 
24
;;
 
25
;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 
26
;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
27
;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
28
;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 
29
;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
30
;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 
31
;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 
32
;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 
33
;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 
34
;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 
35
;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
36
 
 
37
(load "test/unittest.scm")
 
38
 
 
39
(define tn test-name)
 
40
 
 
41
(define elm0 (lambda () #f))
 
42
(define elm1 (lambda () #f))
 
43
(define elm2 (lambda () #f))
 
44
(define elm3 (lambda () #f))
 
45
(define nil  '())
 
46
(define cdr3 (cons elm3 nil))
 
47
(define cdr2 (cons elm2 cdr3))
 
48
(define cdr1 (cons elm1 cdr2))
 
49
(define cdr0 (cons elm0 cdr1))
 
50
(define lst cdr0)
 
51
;; circular lists
 
52
(define clst1 (list 1))
 
53
(set-cdr! clst1 clst1)
 
54
(define clst2 (list 1 2))
 
55
(set-cdr! (list-tail clst2 1) clst2)
 
56
(define clst3 (list 1 2 3))
 
57
(set-cdr! (list-tail clst3 2) clst3)
 
58
(define clst4 (list 1 2 3 4))
 
59
(set-cdr! (list-tail clst4 3) clst4)
 
60
 
 
61
 
 
62
(tn "null?")
 
63
(if (and (provided? "sigscheme")
 
64
         (provided? "siod-bugs"))
 
65
    (assert-eq? (tn) #t (null? #f))
 
66
    (assert-eq? (tn) #f (null? #f)))
 
67
(assert-eq? (tn) #f (null? #t))
 
68
(assert-eq? (tn) #t (null? '()))
 
69
(if (provided? "sigscheme")
 
70
    (begin
 
71
      (assert-eq? (tn) #f (null? (eof)))
 
72
      (assert-eq? (tn) #f (null? (undef)))))
 
73
(assert-eq? (tn) #f (null? 0))
 
74
(assert-eq? (tn) #f (null? 1))
 
75
(assert-eq? (tn) #f (null? 3))
 
76
(assert-eq? (tn) #f (null? -1))
 
77
(assert-eq? (tn) #f (null? -3))
 
78
(assert-eq? (tn) #f (null? 'symbol))
 
79
(assert-eq? (tn) #f (null? 'SYMBOL))
 
80
(assert-eq? (tn) #f (null? #\a))
 
81
(assert-eq? (tn) #f (null? #\あ))
 
82
(assert-eq? (tn) #f (null? ""))
 
83
(assert-eq? (tn) #f (null? " "))
 
84
(assert-eq? (tn) #f (null? "a"))
 
85
(assert-eq? (tn) #f (null? "A"))
 
86
(assert-eq? (tn) #f (null? "aBc12!"))
 
87
(assert-eq? (tn) #f (null? "あ"))
 
88
(assert-eq? (tn) #f (null? "あ0イう12!"))
 
89
(assert-eq? (tn) #f (null? +))
 
90
(assert-eq? (tn) #f (null? (lambda () #t)))
 
91
 
 
92
;; syntactic keywords should not be appeared as operand
 
93
(if sigscheme?
 
94
    (begin
 
95
      ;; pure syntactic keyword
 
96
      (assert-error (tn) (lambda () (null? else)))
 
97
      ;; expression keyword
 
98
      (assert-error (tn) (lambda () (null? do)))))
 
99
 
 
100
(call-with-current-continuation
 
101
 (lambda (k)
 
102
   (assert-eq? (tn) #f (null? k))))
 
103
(assert-eq? (tn) #f (null? (current-output-port)))
 
104
(assert-eq? (tn) #f (null? '(#t . #t)))
 
105
(assert-eq? (tn) #f (null? (cons #t #t)))
 
106
(assert-eq? (tn) #f (null? '(0 1 2)))
 
107
(assert-eq? (tn) #f (null? (list 0 1 2)))
 
108
;; improper lists
 
109
(assert-eq? (tn) #f (null? '(0 . 1)))
 
110
(assert-eq? (tn) #f (null? '(0 1 . 2)))
 
111
(assert-eq? (tn) #f (null? '(0 1 2 . 3)))
 
112
;; circular lists
 
113
(assert-eq? (tn) #f (null? clst1))
 
114
(assert-eq? (tn) #f (null? clst2))
 
115
(assert-eq? (tn) #f (null? clst3))
 
116
(assert-eq? (tn) #f (null? clst4))
 
117
(assert-eq? (tn) #f (null? '#()))
 
118
(assert-eq? (tn) #f (null? (vector)))
 
119
(assert-eq? (tn) #f (null? '#(0 1 2)))
 
120
(assert-eq? (tn) #f (null? (vector 0 1 2)))
 
121
 
 
122
(tn "list?")
 
123
(if (and (provided? "sigscheme")
 
124
         (provided? "siod-bugs"))
 
125
    (assert-eq? (tn) #t (list? #f))
 
126
    (assert-eq? (tn) #f (list? #f)))
 
127
(assert-eq? (tn) #f (list? #t))
 
128
(assert-eq? (tn) #t (list? '()))
 
129
(if (provided? "sigscheme")
 
130
    (begin
 
131
      (assert-eq? (tn) #f (list? (eof)))
 
132
      (assert-eq? (tn) #f (list? (undef)))))
 
133
(assert-eq? (tn) #f (list? 0))
 
134
(assert-eq? (tn) #f (list? 1))
 
135
(assert-eq? (tn) #f (list? 3))
 
136
(assert-eq? (tn) #f (list? -1))
 
137
(assert-eq? (tn) #f (list? -3))
 
138
(assert-eq? (tn) #f (list? 'symbol))
 
139
(assert-eq? (tn) #f (list? 'SYMBOL))
 
140
(assert-eq? (tn) #f (list? #\a))
 
141
(assert-eq? (tn) #f (list? #\あ))
 
142
(assert-eq? (tn) #f (list? ""))
 
143
(assert-eq? (tn) #f (list? " "))
 
144
(assert-eq? (tn) #f (list? "a"))
 
145
(assert-eq? (tn) #f (list? "A"))
 
146
(assert-eq? (tn) #f (list? "aBc12!"))
 
147
(assert-eq? (tn) #f (list? "あ"))
 
148
(assert-eq? (tn) #f (list? "あ0イう12!"))
 
149
(assert-eq? (tn) #f (list? +))
 
150
(assert-eq? (tn) #f (list? (lambda () #t)))
 
151
 
 
152
;; syntactic keywords should not be appeared as operand
 
153
(if sigscheme?
 
154
    (begin
 
155
      ;; pure syntactic keyword
 
156
      (assert-error (tn) (lambda () (list? else)))
 
157
      ;; expression keyword
 
158
      (assert-error (tn) (lambda () (list? do)))))
 
159
 
 
160
(call-with-current-continuation
 
161
 (lambda (k)
 
162
   (assert-eq? (tn) #f (list? k))))
 
163
(assert-eq? (tn) #f (list? (current-output-port)))
 
164
(assert-eq? (tn) #f (list? '(#t . #t)))
 
165
(assert-eq? (tn) #f (list? (cons #t #t)))
 
166
(assert-eq? (tn) #t (list? '(0 1 2)))
 
167
(assert-eq? (tn) #t (list? (list 0 1 2)))
 
168
;; improper lists
 
169
(assert-eq? (tn) #f (list? '(0 . 1)))
 
170
(assert-eq? (tn) #f (list? '(0 1 . 2)))
 
171
(assert-eq? (tn) #f (list? '(0 1 2 . 3)))
 
172
;; circular lists
 
173
(assert-eq? (tn) #f (list? clst1))
 
174
(assert-eq? (tn) #f (list? clst2))
 
175
(assert-eq? (tn) #f (list? clst3))
 
176
(assert-eq? (tn) #f (list? clst4))
 
177
(assert-eq? (tn) #f (list? '#()))
 
178
(assert-eq? (tn) #f (list? (vector)))
 
179
(assert-eq? (tn) #f (list? '#(0 1 2)))
 
180
(assert-eq? (tn) #f (list? (vector 0 1 2)))
 
181
 
 
182
(tn "list? from R5RS examples")
 
183
(assert-eq? (tn) #t (list? '(a b c)))
 
184
(assert-eq? (tn) #t (list? '()))
 
185
(assert-eq? (tn) #f (list? '(a . b)))
 
186
(assert-eq? (tn) #f (list? '(a b . c)))
 
187
(assert-eq? (tn) #f (let ((x (list 'a)))
 
188
                      (set-cdr! x x)
 
189
                      (list? x)))
 
190
 
 
191
(tn "list")
 
192
(assert-equal? (tn) '() (list))
 
193
(assert-equal? (tn) '(a) (list 'a))
 
194
(assert-equal? (tn) '(7) (list (+ 3 4)))
 
195
(assert-equal? (tn) '(7 a c) (list (+ 3 4) 'a 'c))
 
196
(assert-equal? (tn) '(a 7 c) (list 'a (+ 3 4) 'c))
 
197
(assert-equal? (tn) '(a c 7) (list 'a 'c (+ 3 4)))
 
198
(assert-error  (tn) (lambda () (list . 0)))
 
199
(assert-error  (tn) (lambda () (list 0 . 1)))
 
200
 
 
201
(tn "length proper lists")
 
202
(assert-equal? (tn) 0 (length '()))
 
203
(assert-equal? (tn) 1 (length '(1)))
 
204
(assert-equal? (tn) 2 (length '(1 2)))
 
205
(assert-equal? (tn) 3 (length '(1 2 3)))
 
206
(assert-equal? (tn) 4 (length '(1 2 3 4)))
 
207
(tn "length improper lists")
 
208
(assert-error  (tn) (lambda () (length #t)))
 
209
(assert-error  (tn) (lambda () (length '(#t . #t))))
 
210
(assert-error  (tn) (lambda () (length '(#t #t . #t))))
 
211
(assert-error  (tn) (lambda () (length '(#t #t #t . #t))))
 
212
(assert-error  (tn) (lambda () (length '(#t #t #t #t . #t))))
 
213
(assert-error  (tn) (lambda () (length 0)))
 
214
(assert-error  (tn) (lambda () (length '(1 . 2))))
 
215
(assert-error  (tn) (lambda () (length '(1 2 . 3))))
 
216
(assert-error  (tn) (lambda () (length '(1 2 3 . 4))))
 
217
(assert-error  (tn) (lambda () (length '(1 2 3 4 . 5))))
 
218
(tn "length circular lists")
 
219
(assert-error  (tn) (lambda () (length clst1)))
 
220
(assert-error  (tn) (lambda () (length clst2)))
 
221
(assert-error  (tn) (lambda () (length clst3)))
 
222
(assert-error  (tn) (lambda () (length clst4)))
 
223
(tn "length from R5RS examples")
 
224
(assert-equal? (tn) 3 (length '(a b c)))
 
225
(assert-equal? (tn) 3 (length '(a (b) (c d e))))
 
226
(assert-equal? (tn) 0 (length '()))
 
227
 
 
228
(tn "append")
 
229
(assert-equal? (tn) '() (append))
 
230
(assert-equal? (tn) '() (append '()))
 
231
(assert-equal? (tn) '() (append '() '()))
 
232
(assert-equal? (tn) '() (append '() '() '()))
 
233
(assert-equal? (tn) '(a) (append '(a) '() '()))
 
234
(assert-equal? (tn) '(a) (append '() '(a) '()))
 
235
(assert-equal? (tn) '(a) (append '() '() '(a)))
 
236
(assert-equal? (tn) 'a (append 'a))
 
237
(assert-error  (tn) (lambda () (append 'a 'b)))
 
238
(assert-error  (tn) (lambda () (append 'a '(b))))
 
239
(assert-error  (tn) (lambda () (append 'a '())))
 
240
(assert-equal? (tn) '(a . b) (append '(a . b)))
 
241
(assert-error  (tn) (lambda () (append '(a . b) '())))
 
242
(assert-error  (tn) (lambda () (append '() '(a . b) '())))
 
243
(assert-equal? (tn) '(a . b) (append '() '() '(a . b)))
 
244
(assert-equal? (tn) '(1 2 3 a . b) (append '(1) '(2 3) '(a . b)))
 
245
(assert-equal? (tn) 7 (append (+ 3 4)))
 
246
(assert-equal? (tn) '(+ 3 4) (append '(+ 3 4)))
 
247
 
 
248
(assert-equal? (tn) '(x y) (append '(x) '(y)))
 
249
(assert-equal? (tn) '(a b c d) (append '(a) '(b c d)))
 
250
(assert-equal? (tn) '(a (b) (c)) (append '(a (b)) '((c))))
 
251
(define w '(n o))
 
252
(define x '(d o))
 
253
(define y '(car))
 
254
(define z '(why))
 
255
(assert-equal? (tn) '(n o d o car why . ta) (append w x y () z 'ta))
 
256
(assert-equal? (tn) '(n o) w)   ; test non-destructiveness
 
257
(assert-eq?    (tn) x (cdr (append '((Calpis hosi-)) x))) ; share last
 
258
 
 
259
(tn "append from R5RS examples")
 
260
(assert-equal? (tn) '(x y)       (append '(x) '(y)))
 
261
(assert-equal? (tn) '(a b c d)   (append '(a) '(b c d)))
 
262
(assert-equal? (tn) '(a (b) (c)) (append '(a (b)) '((c))))
 
263
(assert-equal? (tn) '(a b c . d) (append '(a b) '(c . d)))
 
264
(assert-equal? (tn) 'a           (append '() 'a))
 
265
 
 
266
(tn "reverse")
 
267
(assert-equal? (tn) '() (reverse '()))
 
268
(assert-error  (tn) (lambda () (reverse)))
 
269
(assert-error  (tn) (lambda () (reverse '(a . b))))
 
270
(assert-error  (tn) (lambda () (reverse 'a)))
 
271
(assert-error  (tn) (lambda () (reverse '() '())))
 
272
(assert-error  (tn) (lambda () (reverse '(a) '())))
 
273
(assert-error  (tn) (lambda () (reverse '() '(a))))
 
274
 
 
275
(tn "reverse from R5RS examples")
 
276
(assert-equal? (tn) '(c b a) (reverse '(a b c)))
 
277
(assert-equal? (tn) '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))
 
278
 
 
279
(tn "list-tail")
 
280
(assert-equal? (tn) '(a b c)   (list-tail '(a b c) 0))
 
281
(assert-equal? (tn) '(b c)     (list-tail '(a b c) 1))
 
282
(assert-equal? (tn) '(c)       (list-tail '(a b c) 2))
 
283
(assert-equal? (tn) '()        (list-tail '(a b c) 3))
 
284
(assert-error  (tn) (lambda () (list-tail '(a b c) 4)))
 
285
(assert-error  (tn) (lambda () (list-tail '(a b c) -1)))
 
286
(assert-equal? (tn) '()        (list-tail '() 0))
 
287
(assert-error  (tn) (lambda () (list-tail '() 1)))
 
288
(assert-error  (tn) (lambda () (list-tail '() -1)))
 
289
(assert-eq?    (tn) cdr0       (list-tail lst 0))
 
290
(assert-eq?    (tn) cdr1       (list-tail lst 1))
 
291
(assert-eq?    (tn) cdr2       (list-tail lst 2))
 
292
(assert-eq?    (tn) cdr3       (list-tail lst 3))
 
293
(assert-eq?    (tn) nil        (list-tail lst 4))
 
294
(assert-error  (tn) (lambda () (list-tail lst 5)))
 
295
(assert-error  (tn) (lambda () (list-tail lst -1)))
 
296
 
 
297
(tn "list-tail improper list")
 
298
(assert-equal? (tn) '(a b c . d) (list-tail '(a b c . d) 0))
 
299
(assert-equal? (tn) '(b c . d)   (list-tail '(a b c . d) 1))
 
300
(assert-equal? (tn) '(c . d)     (list-tail '(a b c . d) 2))
 
301
(assert-equal? (tn) 'd           (list-tail '(a b c . d) 3))
 
302
(assert-error  (tn) (lambda ()   (list-tail '(a b c . d) 4)))
 
303
(assert-error  (tn) (lambda ()   (list-tail '(a b c . d) -1)))
 
304
(assert-equal? (tn) 'a           (list-tail 'a 0))
 
305
(assert-error  (tn) (lambda ()   (list-tail 'a 1)))
 
306
(assert-error  (tn) (lambda ()   (list-tail 'a -1)))
 
307
 
 
308
(tn "list-ref")
 
309
(assert-equal? (tn) 'a         (list-ref '(a b c d) 0))
 
310
(assert-equal? (tn) 'b         (list-ref '(a b c d) 1))
 
311
(assert-equal? (tn) 'c         (list-ref '(a b c d) 2))
 
312
(assert-equal? (tn) 'd         (list-ref '(a b c d) 3))
 
313
(assert-error  (tn) (lambda () (list-ref '(a b c d) 4)))
 
314
(assert-error  (tn) (lambda () (list-ref '(a b c d) -1)))
 
315
(assert-error  (tn) (lambda () (list-ref '() 0)))
 
316
(assert-error  (tn) (lambda () (list-ref '() 1)))
 
317
(assert-error  (tn) (lambda () (list-ref '() -1)))
 
318
(assert-eq?    (tn) elm0       (list-ref lst 0))
 
319
(assert-eq?    (tn) elm1       (list-ref lst 1))
 
320
(assert-eq?    (tn) elm2       (list-ref lst 2))
 
321
(assert-eq?    (tn) elm3       (list-ref lst 3))
 
322
(assert-error  (tn) (lambda () (list-ref lst 4)))
 
323
(assert-error  (tn) (lambda () (list-ref lst -1)))
 
324
 
 
325
(tn "list-ref improper list")
 
326
(assert-equal? (tn) 'a         (list-ref '(a b c . d) 0))
 
327
(assert-equal? (tn) 'b         (list-ref '(a b c . d) 1))
 
328
(assert-equal? (tn) 'c         (list-ref '(a b c . d) 2))
 
329
(assert-error  (tn) (lambda () (list-ref '(a b c . d) 3)))
 
330
(assert-error  (tn) (lambda () (list-ref '(a b c . d) 4)))
 
331
(assert-error  (tn) (lambda () (list-ref '(a b c . d) -1)))
 
332
(assert-error  (tn) (lambda () (list-ref 'a 0)))
 
333
(assert-error  (tn) (lambda () (list-ref 'a 1)))
 
334
(assert-error  (tn) (lambda () (list-ref 'a -1)))
 
335
 
 
336
(if sigscheme?
 
337
    (begin
 
338
      (use sscm)
 
339
      (tn "length* proper list")
 
340
      (assert-equal? (tn) 0 (length* '()))
 
341
      (assert-equal? (tn) 1 (length* '(1)))
 
342
      (assert-equal? (tn) 2 (length* '(1 2)))
 
343
      (assert-equal? (tn) 3 (length* '(1 2 3)))
 
344
      (assert-equal? (tn) 4 (length* '(1 2 3 4)))
 
345
      (tn "length* improper list")
 
346
      (assert-equal? (tn) -1 (length* 1))
 
347
      (assert-equal? (tn) -2 (length* '(1 . 2)))
 
348
      (assert-equal? (tn) -3 (length* '(1 2 . 3)))
 
349
      (assert-equal? (tn) -4 (length* '(1 2 3 . 4)))
 
350
      (assert-equal? (tn) -5 (length* '(1 2 3 4 . 5)))
 
351
      (tn "length* circular list")
 
352
      (assert-eq?    (tn) #f (length* clst1))
 
353
      (assert-eq?    (tn) #f (length* clst2))
 
354
      (assert-eq?    (tn) #f (length* clst3))
 
355
      (assert-eq?    (tn) #f (length* clst4))))
 
356
 
 
357
(total-report)