← Back to branch summary

~ubuntu-branches/ubuntu/precise/uim/precise

« back to all changes in this revision

Viewing changes to test/util/test-r5rs.scm

  • Committer: Package Import Robot
  • Author(s): Ilya Barygin
  • Date: 2011-12-18 16:35:38 UTC
  • mfrom: (1.1.13) (15.1.7 sid)
  • Revision ID: package-import@ubuntu.com-20111218163538-8ktir39z2mjpii8z
Tags: 1:1.7.1-3ubuntu1
https://launchpad.net/bugs/818199
* Merge from Debian testing (LP: #818199).
* Remaining changes:
  - debian/uim-qt.install: Fix plugin path for multiarch location.
* Dropped changes:
  - uim-applet-gnome removal (GNOME 3 applet is available)
  - 19_as-needed_compile_fix.dpatch (accepted into Debian package)
* translations.patch: add several files to POTFILE.in to prevent
  intltool-update failure.

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/util/test-r5rs.scm
 
1
;;; Copyright (c) 2003-2011 uim Project http://code.google.com/p/uim/
 
2
;;;
 
3
;;; All rights reserved.
 
4
;;;
 
5
;;; Redistribution and use in source and binary forms, with or without
 
6
;;; modification, are permitted provided that the following conditions
 
7
;;; are met:
 
8
;;; 1. Redistributions of source code must retain the above copyright
 
9
;;;    notice, this list of conditions and the following disclaimer.
 
10
;;; 2. Redistributions in binary form must reproduce the above copyright
 
11
;;;    notice, this list of conditions and the following disclaimer in the
 
12
;;;    documentation and/or other materials provided with the distribution.
 
13
;;; 3. Neither the name of authors nor the names of its contributors
 
14
;;;    may be used to endorse or promote products derived from this software
 
15
;;;    without specific prior written permission.
 
16
;;;
 
17
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
 
18
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 
19
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 
20
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
 
21
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 
22
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 
23
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 
24
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 
25
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 
26
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 
27
;;; SUCH DAMAGE.
 
28
;;;
 
29
 
 
30
;; These tests are passed at revision 6605 (new repository)
 
31
 
 
32
(define-module test.util.test-r5rs
 
33
  (use test.unit.test-case)
 
34
  (use test.uim-test))
 
35
(select-module test.util.test-r5rs)
 
36
 
 
37
(define (setup)
 
38
  (uim-test-setup)
 
39
  (uim '(define lst '(1 "2" three (4) 5 six "7" (8 8) -9))))
 
40
 
 
41
(define (teardown)
 
42
  (uim-test-teardown))
 
43
 
 
44
(define (test-else)
 
45
  (assert-uim-equal "else"
 
46
                    '(cond
 
47
                       ((equal? 1 11)
 
48
                        1)
 
49
                       ((eq? 'second 'twelve)
 
50
                        2)
 
51
                       ((string=? "third" "thirty")
 
52
                        3)
 
53
                       (else
 
54
                        "else")))
 
55
  (assert-uim-equal 3
 
56
                    '(cond
 
57
                       ((equal? 1 11)
 
58
                        1)
 
59
                       ((eq? 'second 'twelve)
 
60
                        2)
 
61
                       ((string=? "third" "third")
 
62
                        3)
 
63
                       (else
 
64
                        "else")))
 
65
  (assert-uim-false '(cond
 
66
                      ((equal? 1 11)
 
67
                       1)
 
68
                      ((eq? 'second 'twelve)
 
69
                       2)
 
70
                      ((string=? "third" "thirty")
 
71
                       3)
 
72
                      (else
 
73
                       #f)))
 
74
  #f)
 
75
 
 
76
(define (test-boolean?)
 
77
  (assert-uim-true  '(boolean? #f))
 
78
  (assert-uim-true  '(boolean? #t))
 
79
  (assert-uim-false '(boolean? "foo"))
 
80
  (assert-uim-false '(boolean? 'foo))
 
81
  (assert-uim-false '(boolean? -1))
 
82
  (assert-uim-false '(boolean? 0))
 
83
 
 
84
  ;; SIOD
 
85
  ;;(assert-uim-true  '(boolean? 1))  ; Siod specific
 
86
  ;; SigScheme
 
87
  (assert-uim-false '(boolean? 1))
 
88
 
 
89
  (assert-uim-false '(boolean? 10))
 
90
  ;;(assert-uim-true  '(boolean? ())) ; SIOD specific
 
91
  (assert-uim-false '(boolean? ())) ; SigScheme
 
92
  (assert-uim-false '(boolean? '(1 "2" 'three)))
 
93
  (assert-uim-false '(boolean? 'nil))
 
94
  (assert-uim-false '(symbol-bound? 'nil))
 
95
  #f)
 
96
 
 
97
(define (test-integer?)
 
98
  (assert-uim-false '(integer? #f))
 
99
  (assert-uim-false '(integer? "foo"))
 
100
  (assert-uim-false '(integer? 'foo))
 
101
  (assert-uim-true  '(integer? -1))
 
102
  (assert-uim-true  '(integer? 0))
 
103
  (assert-uim-true  '(integer? 1))
 
104
  (assert-uim-true  '(integer? 2))
 
105
  (assert-uim-true  '(integer? 10))
 
106
  (assert-uim-false '(integer? ()))
 
107
  (assert-uim-false '(integer? '(1 "2" 'three)))
 
108
  #f)
 
109
 
 
110
(define (test-list?)
 
111
  ;;(assert-uim-true  '(list? #f)) ; SIOD specific
 
112
  (assert-uim-false '(list? #f)) ; SigScheme
 
113
  (assert-uim-false '(list? "foo"))
 
114
  (assert-uim-false '(list? 'foo))
 
115
  (assert-uim-false '(list? -1))
 
116
  (assert-uim-false '(list? 0))
 
117
  (assert-uim-false '(list? 1))
 
118
  (assert-uim-false '(list? 2))
 
119
  (assert-uim-false '(list? 10))
 
120
  (assert-uim-true  '(list? ()))
 
121
  (assert-uim-true  '(list? '(1)))
 
122
  (assert-uim-true  '(list? '(1 "2")))
 
123
  (assert-uim-true  '(list? '(1 "2" 'three)))
 
124
  #f)
 
125
 
 
126
(define (test-zero?)
 
127
  (assert-uim-error '(zero? #f))
 
128
  (assert-uim-error '(zero? "foo"))
 
129
  (assert-uim-error '(zero? 'foo))
 
130
  (assert-uim-false '(zero? -2))
 
131
  (assert-uim-false '(zero? -1))
 
132
  (assert-uim-true  '(zero? 0))
 
133
  (assert-uim-false '(zero? 1))
 
134
  (assert-uim-false '(zero? 2))
 
135
  (assert-uim-false '(zero? 10))
 
136
  (assert-uim-error '(zero? ()))
 
137
  (assert-uim-error '(zero? '(1)))
 
138
  (assert-uim-error '(zero? '(1 "2")))
 
139
  (assert-uim-error '(zero? '(1 "2" 'three)))
 
140
  #f)
 
141
 
 
142
(define (test-positive?)
 
143
  (assert-uim-error '(positive? #f))
 
144
  (assert-uim-error '(positive? "foo"))
 
145
  (assert-uim-error '(positive? 'foo))
 
146
  (assert-uim-false '(positive? -2))
 
147
  (assert-uim-false '(positive? -1))
 
148
  (assert-uim-false '(positive? 0))
 
149
  (assert-uim-true  '(positive? 1))
 
150
  (assert-uim-true  '(positive? 2))
 
151
  (assert-uim-true  '(positive? 10))
 
152
  (assert-uim-error '(positive? ()))
 
153
  (assert-uim-error '(positive? '(1)))
 
154
  (assert-uim-error '(positive? '(1 "2")))
 
155
  (assert-uim-error '(positive? '(1 "2" 'three)))
 
156
  #f)
 
157
 
 
158
(define (test-negative?)
 
159
  (assert-uim-error '(negative? #f))
 
160
  (assert-uim-error '(negative? "foo"))
 
161
  (assert-uim-error '(negative? 'foo))
 
162
  (assert-uim-true  '(negative? -2))
 
163
  (assert-uim-true  '(negative? -1))
 
164
  (assert-uim-false '(negative? 0))
 
165
  (assert-uim-false '(negative? 1))
 
166
  (assert-uim-false '(negative? 2))
 
167
  (assert-uim-false '(negative? 10))
 
168
  (assert-uim-error '(negative? ()))
 
169
  (assert-uim-error '(negative? '(1)))
 
170
  (assert-uim-error '(negative? '(1 "2")))
 
171
  (assert-uim-error '(negative? '(1 "2" 'three)))
 
172
  #f)
 
173
 
 
174
(define (test-string->symbol)
 
175
  (assert-uim-equal 'foo1
 
176
                    '(string->symbol "foo1"))
 
177
  (assert-uim-equal 'Foo1
 
178
                    '(string->symbol "Foo1"))
 
179
  (assert-uim-equal 'FOO1
 
180
                    '(string->symbol "FOO1"))
 
181
  (assert-uim-equal '1foo
 
182
                    '(string->symbol "1foo"))
 
183
  (assert-uim-equal '1Foo
 
184
                    '(string->symbol "1Foo"))
 
185
  (assert-uim-equal '1FOO
 
186
                    '(string->symbol "1FOO"))
 
187
  #f)
 
188
 
 
189
(define (test-map)
 
190
  (assert-uim-equal '()
 
191
                    '(map not ()))
 
192
  (assert-uim-equal (uim '(list #f))
 
193
                    '(map not '(#t)))
 
194
 
 
195
  ;; these two tests fail due to bug #617 'boolean value
 
196
  ;; representation is inconsistent'
 
197
  (assert-uim-equal (uim '(list #f #t))
 
198
                    '(map not '(#t #f)))
 
199
  (assert-uim-equal (uim '(list #f #t #f))
 
200
                    '(map not '(#t #f #t)))
 
201
 
 
202
  (assert-uim-equal '()
 
203
                    '(map +
 
204
                          '()
 
205
                          '()))
 
206
  (assert-uim-equal '(5)
 
207
                    '(map +
 
208
                          '(1)
 
209
                          '(4)))
 
210
  (assert-uim-equal '(5 7)
 
211
                    '(map +
 
212
                          '(1 2)
 
213
                          '(4 5)))
 
214
  (assert-uim-equal '(5 7 9)
 
215
                    '(map +
 
216
                          '(1 2 3)
 
217
                          '(4 5 6)))
 
218
  (assert-uim-equal '()
 
219
                    '(map +
 
220
                          '()
 
221
                          '()
 
222
                          '()))
 
223
  (assert-uim-equal '(12)
 
224
                    '(map +
 
225
                          '(1)
 
226
                          '(4)
 
227
                          '(7)))
 
228
  (assert-uim-equal '(12 15)
 
229
                    '(map +
 
230
                          '(1 2)
 
231
                          '(4 5)
 
232
                          '(7 8)))
 
233
  (assert-uim-equal '(12 15 18)
 
234
                    '(map +
 
235
                          '(1 2 3)
 
236
                          '(4 5 6)
 
237
                          '(7 8 9)))
 
238
  (assert-uim-equal '()
 
239
                    '(map +
 
240
                          '()
 
241
                          '()
 
242
                          '()
 
243
                          '()))
 
244
  (assert-uim-equal '(22)
 
245
                    '(map +
 
246
                          '(1)
 
247
                          '(4)
 
248
                          '(7)
 
249
                          '(10)))
 
250
  (assert-uim-equal '(22 26)
 
251
                    '(map +
 
252
                          '(1 2)
 
253
                          '(4 5)
 
254
                          '(7 8)
 
255
                          '(10 11)))
 
256
  (assert-uim-equal '(22 26 30)
 
257
                    '(map +
 
258
                          '(1 2 3)
 
259
                          '(4 5 6)
 
260
                          '(7 8 9)
 
261
                          '(10 11 12)))
 
262
  #f)
 
263
 
 
264
(define (test-for-each)
 
265
  (assert-uim-equal 3
 
266
                    '(let ((i 0))
 
267
                       (for-each (lambda (x)
 
268
                                   (set! i (+ i 1)))
 
269
                                 '(1 2 3))
 
270
                       i))
 
271
  (assert-uim-equal 6
 
272
                    '(let ((i 0)
 
273
                           (sum 0))
 
274
                       (for-each (lambda (x)
 
275
                                   (set! i (+ i 1))
 
276
                                   (set! sum (+ sum x)))
 
277
                                 '(1 2 3))
 
278
                       sum))
 
279
  (assert-uim-equal 3
 
280
                    '(let ((i 0))
 
281
                       (for-each (lambda (x y)
 
282
                                   (set! i (+ i 1)))
 
283
                                 '(1 2 3)
 
284
                                 '(4 5 6))
 
285
                       i))
 
286
  (assert-uim-equal 21
 
287
                    '(let ((i 0)
 
288
                           (sum 0))
 
289
                       (for-each (lambda (x y)
 
290
                                   (set! i (+ i 1))
 
291
                                   (set! sum (+ sum x y)))
 
292
                                 '(1 2 3)
 
293
                                 '(4 5 6))
 
294
                        sum))
 
295
  #f)
 
296
 
 
297
(define (test-list-tail)
 
298
  (assert-uim-equal '(1 "2" three (4) 5 six "7" (8 8) -9)
 
299
                    '(list-tail lst 0))
 
300
  (assert-uim-equal '("2" three (4) 5 six "7" (8 8) -9)
 
301
                    '(list-tail lst 1))
 
302
  (assert-uim-equal '(three (4) 5 six "7" (8 8) -9)
 
303
                    '(list-tail lst 2))
 
304
  (assert-uim-equal '((4) 5 six "7" (8 8) -9)
 
305
                    '(list-tail lst 3))
 
306
  (assert-uim-equal '(-9)
 
307
                    '(list-tail lst 8))
 
308
  (assert-uim-equal '()
 
309
                    '(list-tail lst 9))
 
310
  (assert-uim-error '(list-tail lst 10))
 
311
  (assert-uim-error '(list-tail lst -1))
 
312
  #f)
 
313
 
 
314
(provide "test/util/test-r5rs")