← Back to branch summary

~ubuntu-branches/ubuntu/maverick/uim/maverick

« back to all changes in this revision

Viewing changes to sigscheme/test/test-number-pred.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2008-06-25 19:56:33 UTC
  • mfrom: (3.1.18 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080625195633-8jljph4rfq00l8o7
Tags: 1:1.5.1-2
http://bugs.debian.org/482659
http://bugs.debian.org/483078
* uim-tcode: provide tutcode-custom.scm, tutcode-bushudic.scm
  and tutcode-rule.scm (Closes: #482659)
* Fix FTBFS: segv during compile (Closes: #483078).
  I personally think this bug is not specific for uim but is a optimization
  problem on gcc-4.3.1. (https://bugs.freedesktop.org/show_bug.cgi?id=16477)

Show diffs side-by-side

added added

removed removed

Lines of Context:
sigscheme/test/test-number-pred.scm
 
1
#! /usr/bin/env sscm -C UTF-8
 
2
 
 
3
;;  Filename : test-number-pred.scm
 
4
;;  About    : unit tests for number predicates
 
5
;;
 
6
;;  Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
 
7
;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
 
8
;;
 
9
;;  All rights reserved.
 
10
;;
 
11
;;  Redistribution and use in source and binary forms, with or without
 
12
;;  modification, are permitted provided that the following conditions
 
13
;;  are met:
 
14
;;
 
15
;;  1. Redistributions of source code must retain the above copyright
 
16
;;     notice, this list of conditions and the following disclaimer.
 
17
;;  2. Redistributions in binary form must reproduce the above copyright
 
18
;;     notice, this list of conditions and the following disclaimer in the
 
19
;;     documentation and/or other materials provided with the distribution.
 
20
;;  3. Neither the name of authors nor the names of its contributors
 
21
;;     may be used to endorse or promote products derived from this software
 
22
;;     without specific prior written permission.
 
23
;;
 
24
;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 
25
;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 
26
;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
27
;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 
28
;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
29
;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 
30
;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 
31
;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 
32
;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 
33
;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 
34
;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
35
 
 
36
(require-extension (unittest))
 
37
 
 
38
(if (not (symbol-bound? 'number?))
 
39
    (test-skip "R5RS numbers is not enabled"))
 
40
 
 
41
(define tn test-name)
 
42
 
 
43
 
 
44
(tn "number?")
 
45
(assert-eq? (tn) #f (number? #f))
 
46
(assert-eq? (tn) #f (number? #t))
 
47
(assert-eq? (tn) #f (number? '()))
 
48
(if (provided? "sigscheme")
 
49
    (begin
 
50
      (assert-eq? (tn) #f (number? (eof)))
 
51
      (assert-eq? (tn) #f (number? (undef)))))
 
52
 
 
53
;; binary
 
54
(assert-eq? (tn) #t (number? #b0))
 
55
(assert-eq? (tn) #t (number? #b-0))
 
56
(assert-eq? (tn) #t (number? #b+0))
 
57
(assert-eq? (tn) #t (number? #b1))
 
58
(assert-eq? (tn) #t (number? #b-1))
 
59
(assert-eq? (tn) #t (number? #b+1))
 
60
;; octal
 
61
(assert-eq? (tn) #t (number? #o0))
 
62
(assert-eq? (tn) #t (number? #o-0))
 
63
(assert-eq? (tn) #t (number? #o+0))
 
64
(assert-eq? (tn) #t (number? #o1))
 
65
(assert-eq? (tn) #t (number? #o-1))
 
66
(assert-eq? (tn) #t (number? #o+1))
 
67
(assert-eq? (tn) #t (number? #o3))
 
68
(assert-eq? (tn) #t (number? #o-3))
 
69
(assert-eq? (tn) #t (number? #o+3))
 
70
;; decimal (implicit)
 
71
(assert-eq? (tn) #t (number? 0))
 
72
(assert-eq? (tn) #t (number? -0))
 
73
(assert-eq? (tn) #t (number? +0))
 
74
(assert-eq? (tn) #t (number? 1))
 
75
(assert-eq? (tn) #t (number? -1))
 
76
(assert-eq? (tn) #t (number? +1))
 
77
(assert-eq? (tn) #t (number? 3))
 
78
(assert-eq? (tn) #t (number? -3))
 
79
(assert-eq? (tn) #t (number? +3))
 
80
;; decimal (explicit)
 
81
(assert-eq? (tn) #t (number? #d0))
 
82
(assert-eq? (tn) #t (number? #d-0))
 
83
(assert-eq? (tn) #t (number? #d+0))
 
84
(assert-eq? (tn) #t (number? #d1))
 
85
(assert-eq? (tn) #t (number? #d-1))
 
86
(assert-eq? (tn) #t (number? #d+1))
 
87
(assert-eq? (tn) #t (number? #d3))
 
88
(assert-eq? (tn) #t (number? #d-3))
 
89
(assert-eq? (tn) #t (number? #d+3))
 
90
;; hexadecimal
 
91
(assert-eq? (tn) #t (number? #x0))
 
92
(assert-eq? (tn) #t (number? #x-0))
 
93
(assert-eq? (tn) #t (number? #x+0))
 
94
(assert-eq? (tn) #t (number? #x1))
 
95
(assert-eq? (tn) #t (number? #x-1))
 
96
(assert-eq? (tn) #t (number? #x+1))
 
97
(assert-eq? (tn) #t (number? #x3))
 
98
(assert-eq? (tn) #t (number? #x-3))
 
99
(assert-eq? (tn) #t (number? #x+3))
 
100
(assert-eq? (tn) #t (number? #xa))
 
101
(assert-eq? (tn) #t (number? #x-a))
 
102
(assert-eq? (tn) #t (number? #x+a))
 
103
 
 
104
(assert-eq? (tn) #f (number? 'symbol))
 
105
(assert-eq? (tn) #f (number? 'SYMBOL))
 
106
(assert-eq? (tn) #f (number? #\a))
 
107
(assert-eq? (tn) #f (number? #\あ))
 
108
(assert-eq? (tn) #f (number? ""))
 
109
(assert-eq? (tn) #f (number? " "))
 
110
(assert-eq? (tn) #f (number? "a"))
 
111
(assert-eq? (tn) #f (number? "A"))
 
112
(assert-eq? (tn) #f (number? "aBc12!"))
 
113
(assert-eq? (tn) #f (number? "あ"))
 
114
(assert-eq? (tn) #f (number? "あ0イう12!"))
 
115
(assert-eq? (tn) #f (number? +))
 
116
(assert-eq? (tn) #f (number? (lambda () #t)))
 
117
 
 
118
;; syntactic keywords should not be appeared as operand
 
119
(if sigscheme?
 
120
    (begin
 
121
      ;; pure syntactic keyword
 
122
      (assert-error (tn) (lambda () (number? else)))
 
123
      ;; expression keyword
 
124
      (assert-error (tn) (lambda () (number? do)))))
 
125
 
 
126
(call-with-current-continuation
 
127
 (lambda (k)
 
128
   (assert-eq? (tn) #f (number? k))))
 
129
(assert-eq? (tn) #f (number? (current-output-port)))
 
130
(assert-eq? (tn) #f (number? '(#t . #t)))
 
131
(assert-eq? (tn) #f (number? (cons #t #t)))
 
132
(assert-eq? (tn) #f (number? '(0 1 2)))
 
133
(assert-eq? (tn) #f (number? (list 0 1 2)))
 
134
(assert-eq? (tn) #f (number? '#()))
 
135
(assert-eq? (tn) #f (number? (vector)))
 
136
(assert-eq? (tn) #f (number? '#(0 1 2)))
 
137
(assert-eq? (tn) #f (number? (vector 0 1 2)))
 
138
 
 
139
(tn "integer?")
 
140
(assert-eq? (tn) #f (integer? #f))
 
141
(assert-eq? (tn) #f (integer? #t))
 
142
(assert-eq? (tn) #f (integer? '()))
 
143
(if (provided? "sigscheme")
 
144
    (begin
 
145
      (assert-eq? (tn) #f (integer? (eof)))
 
146
      (assert-eq? (tn) #f (integer? (undef)))))
 
147
 
 
148
;; binary
 
149
(assert-eq? (tn) #t (integer? #b0))
 
150
(assert-eq? (tn) #t (integer? #b-0))
 
151
(assert-eq? (tn) #t (integer? #b+0))
 
152
(assert-eq? (tn) #t (integer? #b1))
 
153
(assert-eq? (tn) #t (integer? #b-1))
 
154
(assert-eq? (tn) #t (integer? #b+1))
 
155
;; octal
 
156
(assert-eq? (tn) #t (integer? #o0))
 
157
(assert-eq? (tn) #t (integer? #o-0))
 
158
(assert-eq? (tn) #t (integer? #o+0))
 
159
(assert-eq? (tn) #t (integer? #o1))
 
160
(assert-eq? (tn) #t (integer? #o-1))
 
161
(assert-eq? (tn) #t (integer? #o+1))
 
162
(assert-eq? (tn) #t (integer? #o3))
 
163
(assert-eq? (tn) #t (integer? #o-3))
 
164
(assert-eq? (tn) #t (integer? #o+3))
 
165
;; decimal (implicit)
 
166
(assert-eq? (tn) #t (integer? 0))
 
167
(assert-eq? (tn) #t (integer? -0))
 
168
(assert-eq? (tn) #t (integer? +0))
 
169
(assert-eq? (tn) #t (integer? 1))
 
170
(assert-eq? (tn) #t (integer? -1))
 
171
(assert-eq? (tn) #t (integer? +1))
 
172
(assert-eq? (tn) #t (integer? 3))
 
173
(assert-eq? (tn) #t (integer? -3))
 
174
(assert-eq? (tn) #t (integer? +3))
 
175
;; decimal (explicit)
 
176
(assert-eq? (tn) #t (integer? #d0))
 
177
(assert-eq? (tn) #t (integer? #d-0))
 
178
(assert-eq? (tn) #t (integer? #d+0))
 
179
(assert-eq? (tn) #t (integer? #d1))
 
180
(assert-eq? (tn) #t (integer? #d-1))
 
181
(assert-eq? (tn) #t (integer? #d+1))
 
182
(assert-eq? (tn) #t (integer? #d3))
 
183
(assert-eq? (tn) #t (integer? #d-3))
 
184
(assert-eq? (tn) #t (integer? #d+3))
 
185
;; hexadecimal
 
186
(assert-eq? (tn) #t (integer? #x0))
 
187
(assert-eq? (tn) #t (integer? #x-0))
 
188
(assert-eq? (tn) #t (integer? #x+0))
 
189
(assert-eq? (tn) #t (integer? #x1))
 
190
(assert-eq? (tn) #t (integer? #x-1))
 
191
(assert-eq? (tn) #t (integer? #x+1))
 
192
(assert-eq? (tn) #t (integer? #x3))
 
193
(assert-eq? (tn) #t (integer? #x-3))
 
194
(assert-eq? (tn) #t (integer? #x+3))
 
195
(assert-eq? (tn) #t (integer? #xa))
 
196
(assert-eq? (tn) #t (integer? #x-a))
 
197
(assert-eq? (tn) #t (integer? #x+a))
 
198
 
 
199
(assert-eq? (tn) #f (integer? 'symbol))
 
200
(assert-eq? (tn) #f (integer? 'SYMBOL))
 
201
(assert-eq? (tn) #f (integer? #\a))
 
202
(assert-eq? (tn) #f (integer? #\あ))
 
203
(assert-eq? (tn) #f (integer? ""))
 
204
(assert-eq? (tn) #f (integer? " "))
 
205
(assert-eq? (tn) #f (integer? "a"))
 
206
(assert-eq? (tn) #f (integer? "A"))
 
207
(assert-eq? (tn) #f (integer? "aBc12!"))
 
208
(assert-eq? (tn) #f (integer? "あ"))
 
209
(assert-eq? (tn) #f (integer? "あ0イう12!"))
 
210
(assert-eq? (tn) #f (integer? +))
 
211
(assert-eq? (tn) #f (integer? (lambda () #t)))
 
212
 
 
213
;; syntactic keywords should not be appeared as operand
 
214
(if sigscheme?
 
215
    (begin
 
216
      ;; pure syntactic keyword
 
217
      (assert-error (tn) (lambda () (integer? else)))
 
218
      ;; expression keyword
 
219
      (assert-error (tn) (lambda () (integer? do)))))
 
220
 
 
221
(call-with-current-continuation
 
222
 (lambda (k)
 
223
   (assert-eq? (tn) #f (integer? k))))
 
224
(assert-eq? (tn) #f (integer? (current-output-port)))
 
225
(assert-eq? (tn) #f (integer? '(#t . #t)))
 
226
(assert-eq? (tn) #f (integer? (cons #t #t)))
 
227
(assert-eq? (tn) #f (integer? '(0 1 2)))
 
228
(assert-eq? (tn) #f (integer? (list 0 1 2)))
 
229
(assert-eq? (tn) #f (integer? '#()))
 
230
(assert-eq? (tn) #f (integer? (vector)))
 
231
(assert-eq? (tn) #f (integer? '#(0 1 2)))
 
232
(assert-eq? (tn) #f (integer? (vector 0 1 2)))
 
233
 
 
234
(tn "zero?")
 
235
(assert-error (tn) (lambda () (zero? #f)))
 
236
(assert-error (tn) (lambda () (zero? #t)))
 
237
(assert-error (tn) (lambda () (zero? '())))
 
238
(if (provided? "sigscheme")
 
239
    (begin
 
240
      (assert-error (tn) (lambda () (zero? (eof))))
 
241
      (assert-error (tn) (lambda () (zero? (undef))))))
 
242
 
 
243
;; binary
 
244
(assert-eq? (tn) #t (zero? #b0))
 
245
(assert-eq? (tn) #t (zero? #b-0))
 
246
(assert-eq? (tn) #t (zero? #b+0))
 
247
(assert-eq? (tn) #f (zero? #b1))
 
248
(assert-eq? (tn) #f (zero? #b-1))
 
249
(assert-eq? (tn) #f (zero? #b+1))
 
250
;; octal
 
251
(assert-eq? (tn) #t (zero? #o0))
 
252
(assert-eq? (tn) #t (zero? #o-0))
 
253
(assert-eq? (tn) #t (zero? #o+0))
 
254
(assert-eq? (tn) #f (zero? #o1))
 
255
(assert-eq? (tn) #f (zero? #o-1))
 
256
(assert-eq? (tn) #f (zero? #o+1))
 
257
(assert-eq? (tn) #f (zero? #o3))
 
258
(assert-eq? (tn) #f (zero? #o-3))
 
259
(assert-eq? (tn) #f (zero? #o+3))
 
260
;; decimal (implicit)
 
261
(assert-eq? (tn) #t (zero? 0))
 
262
(assert-eq? (tn) #t (zero? -0))
 
263
(assert-eq? (tn) #t (zero? +0))
 
264
(assert-eq? (tn) #f (zero? 1))
 
265
(assert-eq? (tn) #f (zero? -1))
 
266
(assert-eq? (tn) #f (zero? +1))
 
267
(assert-eq? (tn) #f (zero? 3))
 
268
(assert-eq? (tn) #f (zero? -3))
 
269
(assert-eq? (tn) #f (zero? +3))
 
270
;; decimal (explicit)
 
271
(assert-eq? (tn) #t (zero? #d0))
 
272
(assert-eq? (tn) #t (zero? #d-0))
 
273
(assert-eq? (tn) #t (zero? #d+0))
 
274
(assert-eq? (tn) #f (zero? #d1))
 
275
(assert-eq? (tn) #f (zero? #d-1))
 
276
(assert-eq? (tn) #f (zero? #d+1))
 
277
(assert-eq? (tn) #f (zero? #d3))
 
278
(assert-eq? (tn) #f (zero? #d-3))
 
279
(assert-eq? (tn) #f (zero? #d+3))
 
280
;; hexadecimal
 
281
(assert-eq? (tn) #t (zero? #x0))
 
282
(assert-eq? (tn) #t (zero? #x-0))
 
283
(assert-eq? (tn) #t (zero? #x+0))
 
284
(assert-eq? (tn) #f (zero? #x1))
 
285
(assert-eq? (tn) #f (zero? #x-1))
 
286
(assert-eq? (tn) #f (zero? #x+1))
 
287
(assert-eq? (tn) #f (zero? #x3))
 
288
(assert-eq? (tn) #f (zero? #x-3))
 
289
(assert-eq? (tn) #f (zero? #x+3))
 
290
(assert-eq? (tn) #f (zero? #xa))
 
291
(assert-eq? (tn) #f (zero? #x-a))
 
292
(assert-eq? (tn) #f (zero? #x+a))
 
293
 
 
294
(assert-error (tn) (lambda () (zero? 'symbol)))
 
295
(assert-error (tn) (lambda () (zero? 'SYMBOL)))
 
296
(assert-error (tn) (lambda () (zero? #\a)))
 
297
(assert-error (tn) (lambda () (zero? #\あ)))
 
298
(assert-error (tn) (lambda () (zero? "")))
 
299
(assert-error (tn) (lambda () (zero? " ")))
 
300
(assert-error (tn) (lambda () (zero? "a")))
 
301
(assert-error (tn) (lambda () (zero? "A")))
 
302
(assert-error (tn) (lambda () (zero? "aBc12!")))
 
303
(assert-error (tn) (lambda () (zero? "あ")))
 
304
(assert-error (tn) (lambda () (zero? "あ0イう12!")))
 
305
(assert-error (tn) (lambda () (zero? +)))
 
306
(assert-error (tn) (lambda () (zero? (lambda () #t))))
 
307
 
 
308
;; syntactic keywords should not be appeared as operand
 
309
(if sigscheme?
 
310
    (begin
 
311
      ;; pure syntactic keyword
 
312
      (assert-error (tn) (lambda () (zero? else)))
 
313
      ;; expression keyword
 
314
      (assert-error (tn) (lambda () (zero? do)))))
 
315
 
 
316
(call-with-current-continuation
 
317
 (lambda (k)
 
318
   (assert-error (tn) (lambda () (zero? k)))))
 
319
(assert-error (tn) (lambda () (zero? (current-output-port))))
 
320
(assert-error (tn) (lambda () (zero? '(#t . #t))))
 
321
(assert-error (tn) (lambda () (zero? (cons #t #t))))
 
322
(assert-error (tn) (lambda () (zero? '(0 1 2))))
 
323
(assert-error (tn) (lambda () (zero? (list 0 1 2))))
 
324
(assert-error (tn) (lambda () (zero? '#())))
 
325
(assert-error (tn) (lambda () (zero? (vector))))
 
326
(assert-error (tn) (lambda () (zero? '#(0 1 2))))
 
327
(assert-error (tn) (lambda () (zero? (vector 0 1 2))))
 
328
 
 
329
(tn "positive?")
 
330
(assert-error (tn) (lambda () (positive? #f)))
 
331
(assert-error (tn) (lambda () (positive? #t)))
 
332
(assert-error (tn) (lambda () (positive? '())))
 
333
(if (provided? "sigscheme")
 
334
    (begin
 
335
      (assert-error (tn) (lambda () (positive? (eof))))
 
336
      (assert-error (tn) (lambda () (positive? (undef))))))
 
337
 
 
338
;; binary
 
339
(assert-eq? (tn) #f (positive? #b0))
 
340
(assert-eq? (tn) #f (positive? #b-0))
 
341
(assert-eq? (tn) #f (positive? #b+0))
 
342
(assert-eq? (tn) #t (positive? #b1))
 
343
(assert-eq? (tn) #f (positive? #b-1))
 
344
(assert-eq? (tn) #t (positive? #b+1))
 
345
;; octal
 
346
(assert-eq? (tn) #f (positive? #o0))
 
347
(assert-eq? (tn) #f (positive? #o-0))
 
348
(assert-eq? (tn) #f (positive? #o+0))
 
349
(assert-eq? (tn) #t (positive? #o1))
 
350
(assert-eq? (tn) #f (positive? #o-1))
 
351
(assert-eq? (tn) #t (positive? #o+1))
 
352
(assert-eq? (tn) #t (positive? #o3))
 
353
(assert-eq? (tn) #f (positive? #o-3))
 
354
(assert-eq? (tn) #t (positive? #o+3))
 
355
;; decimal (implicit)
 
356
(assert-eq? (tn) #f (positive? 0))
 
357
(assert-eq? (tn) #f (positive? -0))
 
358
(assert-eq? (tn) #f (positive? +0))
 
359
(assert-eq? (tn) #t (positive? 1))
 
360
(assert-eq? (tn) #f (positive? -1))
 
361
(assert-eq? (tn) #t (positive? +1))
 
362
(assert-eq? (tn) #t (positive? 3))
 
363
(assert-eq? (tn) #f (positive? -3))
 
364
(assert-eq? (tn) #t (positive? +3))
 
365
;; decimal (explicit)
 
366
(assert-eq? (tn) #f (positive? #d0))
 
367
(assert-eq? (tn) #f (positive? #d-0))
 
368
(assert-eq? (tn) #f (positive? #d+0))
 
369
(assert-eq? (tn) #t (positive? #d1))
 
370
(assert-eq? (tn) #f (positive? #d-1))
 
371
(assert-eq? (tn) #t (positive? #d+1))
 
372
(assert-eq? (tn) #t (positive? #d3))
 
373
(assert-eq? (tn) #f (positive? #d-3))
 
374
(assert-eq? (tn) #t (positive? #d+3))
 
375
;; hexadecimal
 
376
(assert-eq? (tn) #f (positive? #x0))
 
377
(assert-eq? (tn) #f (positive? #x-0))
 
378
(assert-eq? (tn) #f (positive? #x+0))
 
379
(assert-eq? (tn) #t (positive? #x1))
 
380
(assert-eq? (tn) #f (positive? #x-1))
 
381
(assert-eq? (tn) #t (positive? #x+1))
 
382
(assert-eq? (tn) #t (positive? #x3))
 
383
(assert-eq? (tn) #f (positive? #x-3))
 
384
(assert-eq? (tn) #t (positive? #x+3))
 
385
(assert-eq? (tn) #t (positive? #xa))
 
386
(assert-eq? (tn) #f (positive? #x-a))
 
387
(assert-eq? (tn) #t (positive? #x+a))
 
388
 
 
389
(assert-error (tn) (lambda () (positive? 'symbol)))
 
390
(assert-error (tn) (lambda () (positive? 'SYMBOL)))
 
391
(assert-error (tn) (lambda () (positive? #\a)))
 
392
(assert-error (tn) (lambda () (positive? #\あ)))
 
393
(assert-error (tn) (lambda () (positive? "")))
 
394
(assert-error (tn) (lambda () (positive? " ")))
 
395
(assert-error (tn) (lambda () (positive? "a")))
 
396
(assert-error (tn) (lambda () (positive? "A")))
 
397
(assert-error (tn) (lambda () (positive? "aBc12!")))
 
398
(assert-error (tn) (lambda () (positive? "あ")))
 
399
(assert-error (tn) (lambda () (positive? "あ0イう12!")))
 
400
(assert-error (tn) (lambda () (positive? +)))
 
401
(assert-error (tn) (lambda () (positive? (lambda () #t))))
 
402
 
 
403
;; syntactic keywords should not be appeared as operand
 
404
(if sigscheme?
 
405
    (begin
 
406
      ;; pure syntactic keyword
 
407
      (assert-error (tn) (lambda () (positive? else)))
 
408
      ;; expression keyword
 
409
      (assert-error (tn) (lambda () (positive? do)))))
 
410
 
 
411
(call-with-current-continuation
 
412
 (lambda (k)
 
413
   (assert-error (tn) (lambda () (positive? k)))))
 
414
(assert-error (tn) (lambda () (positive? (current-output-port))))
 
415
(assert-error (tn) (lambda () (positive? '(#t . #t))))
 
416
(assert-error (tn) (lambda () (positive? (cons #t #t))))
 
417
(assert-error (tn) (lambda () (positive? '(0 1 2))))
 
418
(assert-error (tn) (lambda () (positive? (list 0 1 2))))
 
419
(assert-error (tn) (lambda () (positive? '#())))
 
420
(assert-error (tn) (lambda () (positive? (vector))))
 
421
(assert-error (tn) (lambda () (positive? '#(0 1 2))))
 
422
(assert-error (tn) (lambda () (positive? (vector 0 1 2))))
 
423
 
 
424
(tn "negative?")
 
425
(assert-error (tn) (lambda () (negative? #f)))
 
426
(assert-error (tn) (lambda () (negative? #t)))
 
427
(assert-error (tn) (lambda () (negative? '())))
 
428
(if (provided? "sigscheme")
 
429
    (begin
 
430
      (assert-error (tn) (lambda () (negative? (eof))))
 
431
      (assert-error (tn) (lambda () (negative? (undef))))))
 
432
 
 
433
;; binary
 
434
(assert-eq? (tn) #f (negative? #b0))
 
435
(assert-eq? (tn) #f (negative? #b-0))
 
436
(assert-eq? (tn) #f (negative? #b+0))
 
437
(assert-eq? (tn) #f (negative? #b1))
 
438
(assert-eq? (tn) #t (negative? #b-1))
 
439
(assert-eq? (tn) #f (negative? #b+1))
 
440
;; octal
 
441
(assert-eq? (tn) #f (negative? #o0))
 
442
(assert-eq? (tn) #f (negative? #o-0))
 
443
(assert-eq? (tn) #f (negative? #o+0))
 
444
(assert-eq? (tn) #f (negative? #o1))
 
445
(assert-eq? (tn) #t (negative? #o-1))
 
446
(assert-eq? (tn) #f (negative? #o+1))
 
447
(assert-eq? (tn) #f (negative? #o3))
 
448
(assert-eq? (tn) #t (negative? #o-3))
 
449
(assert-eq? (tn) #f (negative? #o+3))
 
450
;; decimal (implicit)
 
451
(assert-eq? (tn) #f (negative? 0))
 
452
(assert-eq? (tn) #f (negative? -0))
 
453
(assert-eq? (tn) #f (negative? +0))
 
454
(assert-eq? (tn) #f (negative? 1))
 
455
(assert-eq? (tn) #t (negative? -1))
 
456
(assert-eq? (tn) #f (negative? +1))
 
457
(assert-eq? (tn) #f (negative? 3))
 
458
(assert-eq? (tn) #t (negative? -3))
 
459
(assert-eq? (tn) #f (negative? +3))
 
460
;; decimal (explicit)
 
461
(assert-eq? (tn) #f (negative? #d0))
 
462
(assert-eq? (tn) #f (negative? #d-0))
 
463
(assert-eq? (tn) #f (negative? #d+0))
 
464
(assert-eq? (tn) #f (negative? #d1))
 
465
(assert-eq? (tn) #t (negative? #d-1))
 
466
(assert-eq? (tn) #f (negative? #d+1))
 
467
(assert-eq? (tn) #f (negative? #d3))
 
468
(assert-eq? (tn) #t (negative? #d-3))
 
469
(assert-eq? (tn) #f (negative? #d+3))
 
470
;; hexadecimal
 
471
(assert-eq? (tn) #f (negative? #x0))
 
472
(assert-eq? (tn) #f (negative? #x-0))
 
473
(assert-eq? (tn) #f (negative? #x+0))
 
474
(assert-eq? (tn) #f (negative? #x1))
 
475
(assert-eq? (tn) #t (negative? #x-1))
 
476
(assert-eq? (tn) #f (negative? #x+1))
 
477
(assert-eq? (tn) #f (negative? #x3))
 
478
(assert-eq? (tn) #t (negative? #x-3))
 
479
(assert-eq? (tn) #f (negative? #x+3))
 
480
(assert-eq? (tn) #f (negative? #xa))
 
481
(assert-eq? (tn) #t (negative? #x-a))
 
482
(assert-eq? (tn) #f (negative? #x+a))
 
483
 
 
484
(assert-error (tn) (lambda () (negative? 'symbol)))
 
485
(assert-error (tn) (lambda () (negative? 'SYMBOL)))
 
486
(assert-error (tn) (lambda () (negative? #\a)))
 
487
(assert-error (tn) (lambda () (negative? #\あ)))
 
488
(assert-error (tn) (lambda () (negative? "")))
 
489
(assert-error (tn) (lambda () (negative? " ")))
 
490
(assert-error (tn) (lambda () (negative? "a")))
 
491
(assert-error (tn) (lambda () (negative? "A")))
 
492
(assert-error (tn) (lambda () (negative? "aBc12!")))
 
493
(assert-error (tn) (lambda () (negative? "あ")))
 
494
(assert-error (tn) (lambda () (negative? "あ0イう12!")))
 
495
(assert-error (tn) (lambda () (negative? +)))
 
496
(assert-error (tn) (lambda () (negative? (lambda () #t))))
 
497
 
 
498
;; syntactic keywords should not be appeared as operand
 
499
(if sigscheme?
 
500
    (begin
 
501
      ;; pure syntactic keyword
 
502
      (assert-error (tn) (lambda () (negative? else)))
 
503
      ;; expression keyword
 
504
      (assert-error (tn) (lambda () (negative? do)))))
 
505
 
 
506
(call-with-current-continuation
 
507
 (lambda (k)
 
508
   (assert-error (tn) (lambda () (negative? k)))))
 
509
(assert-error (tn) (lambda () (negative? (current-output-port))))
 
510
(assert-error (tn) (lambda () (negative? '(#t . #t))))
 
511
(assert-error (tn) (lambda () (negative? (cons #t #t))))
 
512
(assert-error (tn) (lambda () (negative? '(0 1 2))))
 
513
(assert-error (tn) (lambda () (negative? (list 0 1 2))))
 
514
(assert-error (tn) (lambda () (negative? '#())))
 
515
(assert-error (tn) (lambda () (negative? (vector))))
 
516
(assert-error (tn) (lambda () (negative? '#(0 1 2))))
 
517
(assert-error (tn) (lambda () (negative? (vector 0 1 2))))
 
518
 
 
519
(tn "odd?")
 
520
(assert-error (tn) (lambda () (odd? #f)))
 
521
(assert-error (tn) (lambda () (odd? #t)))
 
522
(assert-error (tn) (lambda () (odd? '())))
 
523
(if (provided? "sigscheme")
 
524
    (begin
 
525
      (assert-error (tn) (lambda () (odd? (eof))))
 
526
      (assert-error (tn) (lambda () (odd? (undef))))))
 
527
 
 
528
;; binary
 
529
(assert-eq? (tn) #f (odd? #b0))
 
530
(assert-eq? (tn) #f (odd? #b-0))
 
531
(assert-eq? (tn) #f (odd? #b+0))
 
532
(assert-eq? (tn) #t (odd? #b1))
 
533
(assert-eq? (tn) #t (odd? #b-1))
 
534
(assert-eq? (tn) #t (odd? #b+1))
 
535
(assert-eq? (tn) #f (odd? #b10))
 
536
(assert-eq? (tn) #f (odd? #b-10))
 
537
(assert-eq? (tn) #f (odd? #b+10))
 
538
(assert-eq? (tn) #t (odd? #b11))
 
539
(assert-eq? (tn) #t (odd? #b-11))
 
540
(assert-eq? (tn) #t (odd? #b+11))
 
541
(assert-eq? (tn) #f (odd? #b100))
 
542
(assert-eq? (tn) #f (odd? #b-100))
 
543
(assert-eq? (tn) #f (odd? #b+100))
 
544
;; octal
 
545
(assert-eq? (tn) #f (odd? #o0))
 
546
(assert-eq? (tn) #f (odd? #o-0))
 
547
(assert-eq? (tn) #f (odd? #o+0))
 
548
(assert-eq? (tn) #t (odd? #o1))
 
549
(assert-eq? (tn) #t (odd? #o-1))
 
550
(assert-eq? (tn) #t (odd? #o+1))
 
551
(assert-eq? (tn) #f (odd? #o2))
 
552
(assert-eq? (tn) #f (odd? #o-2))
 
553
(assert-eq? (tn) #f (odd? #o+2))
 
554
(assert-eq? (tn) #t (odd? #o3))
 
555
(assert-eq? (tn) #t (odd? #o-3))
 
556
(assert-eq? (tn) #t (odd? #o+3))
 
557
(assert-eq? (tn) #f (odd? #o4))
 
558
(assert-eq? (tn) #f (odd? #o-4))
 
559
(assert-eq? (tn) #f (odd? #o+4))
 
560
;; decimal (implicit)
 
561
(assert-eq? (tn) #f (odd? 0))
 
562
(assert-eq? (tn) #f (odd? -0))
 
563
(assert-eq? (tn) #f (odd? +0))
 
564
(assert-eq? (tn) #t (odd? 1))
 
565
(assert-eq? (tn) #t (odd? -1))
 
566
(assert-eq? (tn) #t (odd? +1))
 
567
(assert-eq? (tn) #f (odd? 2))
 
568
(assert-eq? (tn) #f (odd? -2))
 
569
(assert-eq? (tn) #f (odd? +2))
 
570
(assert-eq? (tn) #t (odd? 3))
 
571
(assert-eq? (tn) #t (odd? -3))
 
572
(assert-eq? (tn) #t (odd? +3))
 
573
(assert-eq? (tn) #f (odd? 4))
 
574
(assert-eq? (tn) #f (odd? -4))
 
575
(assert-eq? (tn) #f (odd? +4))
 
576
;; decimal (explicit)
 
577
(assert-eq? (tn) #f (odd? #d0))
 
578
(assert-eq? (tn) #f (odd? #d-0))
 
579
(assert-eq? (tn) #f (odd? #d+0))
 
580
(assert-eq? (tn) #t (odd? #d1))
 
581
(assert-eq? (tn) #t (odd? #d-1))
 
582
(assert-eq? (tn) #t (odd? #d+1))
 
583
(assert-eq? (tn) #f (odd? #d2))
 
584
(assert-eq? (tn) #f (odd? #d-2))
 
585
(assert-eq? (tn) #f (odd? #d+2))
 
586
(assert-eq? (tn) #t (odd? #d3))
 
587
(assert-eq? (tn) #t (odd? #d-3))
 
588
(assert-eq? (tn) #t (odd? #d+3))
 
589
(assert-eq? (tn) #f (odd? #d4))
 
590
(assert-eq? (tn) #f (odd? #d-4))
 
591
(assert-eq? (tn) #f (odd? #d+4))
 
592
;; hexadecimal
 
593
(assert-eq? (tn) #f (odd? #x0))
 
594
(assert-eq? (tn) #f (odd? #x-0))
 
595
(assert-eq? (tn) #f (odd? #x+0))
 
596
(assert-eq? (tn) #t (odd? #x1))
 
597
(assert-eq? (tn) #t (odd? #x-1))
 
598
(assert-eq? (tn) #t (odd? #x+1))
 
599
(assert-eq? (tn) #f (odd? #x2))
 
600
(assert-eq? (tn) #f (odd? #x-2))
 
601
(assert-eq? (tn) #f (odd? #x+2))
 
602
(assert-eq? (tn) #t (odd? #x3))
 
603
(assert-eq? (tn) #t (odd? #x-3))
 
604
(assert-eq? (tn) #t (odd? #x+3))
 
605
(assert-eq? (tn) #f (odd? #x4))
 
606
(assert-eq? (tn) #f (odd? #x-4))
 
607
(assert-eq? (tn) #f (odd? #x+4))
 
608
(assert-eq? (tn) #f (odd? #xa))
 
609
(assert-eq? (tn) #f (odd? #x-a))
 
610
(assert-eq? (tn) #f (odd? #x+a))
 
611
(assert-eq? (tn) #t (odd? #xb))
 
612
(assert-eq? (tn) #t (odd? #x-b))
 
613
(assert-eq? (tn) #t (odd? #x+b))
 
614
 
 
615
(assert-error (tn) (lambda () (odd? 'symbol)))
 
616
(assert-error (tn) (lambda () (odd? 'SYMBOL)))
 
617
(assert-error (tn) (lambda () (odd? #\a)))
 
618
(assert-error (tn) (lambda () (odd? #\あ)))
 
619
(assert-error (tn) (lambda () (odd? "")))
 
620
(assert-error (tn) (lambda () (odd? " ")))
 
621
(assert-error (tn) (lambda () (odd? "a")))
 
622
(assert-error (tn) (lambda () (odd? "A")))
 
623
(assert-error (tn) (lambda () (odd? "aBc12!")))
 
624
(assert-error (tn) (lambda () (odd? "あ")))
 
625
(assert-error (tn) (lambda () (odd? "あ0イう12!")))
 
626
(assert-error (tn) (lambda () (odd? +)))
 
627
(assert-error (tn) (lambda () (odd? (lambda () #t))))
 
628
 
 
629
;; syntactic keywords should not be appeared as operand
 
630
(if sigscheme?
 
631
    (begin
 
632
      ;; pure syntactic keyword
 
633
      (assert-error (tn) (lambda () (odd? else)))
 
634
      ;; expression keyword
 
635
      (assert-error (tn) (lambda () (odd? do)))))
 
636
 
 
637
(call-with-current-continuation
 
638
 (lambda (k)
 
639
   (assert-error (tn) (lambda () (odd? k)))))
 
640
(assert-error (tn) (lambda () (odd? (current-output-port))))
 
641
(assert-error (tn) (lambda () (odd? '(#t . #t))))
 
642
(assert-error (tn) (lambda () (odd? (cons #t #t))))
 
643
(assert-error (tn) (lambda () (odd? '(0 1 2))))
 
644
(assert-error (tn) (lambda () (odd? (list 0 1 2))))
 
645
(assert-error (tn) (lambda () (odd? '#())))
 
646
(assert-error (tn) (lambda () (odd? (vector))))
 
647
(assert-error (tn) (lambda () (odd? '#(0 1 2))))
 
648
(assert-error (tn) (lambda () (odd? (vector 0 1 2))))
 
649
 
 
650
(tn "even?")
 
651
(assert-error (tn) (lambda () (even? #f)))
 
652
(assert-error (tn) (lambda () (even? #t)))
 
653
(assert-error (tn) (lambda () (even? '())))
 
654
(if (provided? "sigscheme")
 
655
    (begin
 
656
      (assert-error (tn) (lambda () (even? (eof))))
 
657
      (assert-error (tn) (lambda () (even? (undef))))))
 
658
 
 
659
;; binary
 
660
(assert-eq? (tn) #t (even? #b0))
 
661
(assert-eq? (tn) #t (even? #b-0))
 
662
(assert-eq? (tn) #t (even? #b+0))
 
663
(assert-eq? (tn) #f (even? #b1))
 
664
(assert-eq? (tn) #f (even? #b-1))
 
665
(assert-eq? (tn) #f (even? #b+1))
 
666
(assert-eq? (tn) #t (even? #b10))
 
667
(assert-eq? (tn) #t (even? #b-10))
 
668
(assert-eq? (tn) #t (even? #b+10))
 
669
(assert-eq? (tn) #f (even? #b11))
 
670
(assert-eq? (tn) #f (even? #b-11))
 
671
(assert-eq? (tn) #f (even? #b+11))
 
672
(assert-eq? (tn) #t (even? #b100))
 
673
(assert-eq? (tn) #t (even? #b-100))
 
674
(assert-eq? (tn) #t (even? #b+100))
 
675
;; octal
 
676
(assert-eq? (tn) #t (even? #o0))
 
677
(assert-eq? (tn) #t (even? #o-0))
 
678
(assert-eq? (tn) #t (even? #o+0))
 
679
(assert-eq? (tn) #f (even? #o1))
 
680
(assert-eq? (tn) #f (even? #o-1))
 
681
(assert-eq? (tn) #f (even? #o+1))
 
682
(assert-eq? (tn) #t (even? #o2))
 
683
(assert-eq? (tn) #t (even? #o-2))
 
684
(assert-eq? (tn) #t (even? #o+2))
 
685
(assert-eq? (tn) #f (even? #o3))
 
686
(assert-eq? (tn) #f (even? #o-3))
 
687
(assert-eq? (tn) #f (even? #o+3))
 
688
(assert-eq? (tn) #t (even? #o4))
 
689
(assert-eq? (tn) #t (even? #o-4))
 
690
(assert-eq? (tn) #t (even? #o+4))
 
691
;; decimal (implicit)
 
692
(assert-eq? (tn) #t (even? 0))
 
693
(assert-eq? (tn) #t (even? -0))
 
694
(assert-eq? (tn) #t (even? +0))
 
695
(assert-eq? (tn) #f (even? 1))
 
696
(assert-eq? (tn) #f (even? -1))
 
697
(assert-eq? (tn) #f (even? +1))
 
698
(assert-eq? (tn) #t (even? 2))
 
699
(assert-eq? (tn) #t (even? -2))
 
700
(assert-eq? (tn) #t (even? +2))
 
701
(assert-eq? (tn) #f (even? 3))
 
702
(assert-eq? (tn) #f (even? -3))
 
703
(assert-eq? (tn) #f (even? +3))
 
704
(assert-eq? (tn) #t (even? 4))
 
705
(assert-eq? (tn) #t (even? -4))
 
706
(assert-eq? (tn) #t (even? +4))
 
707
;; decimal (explicit)
 
708
(assert-eq? (tn) #t (even? #d0))
 
709
(assert-eq? (tn) #t (even? #d-0))
 
710
(assert-eq? (tn) #t (even? #d+0))
 
711
(assert-eq? (tn) #f (even? #d1))
 
712
(assert-eq? (tn) #f (even? #d-1))
 
713
(assert-eq? (tn) #f (even? #d+1))
 
714
(assert-eq? (tn) #t (even? #d2))
 
715
(assert-eq? (tn) #t (even? #d-2))
 
716
(assert-eq? (tn) #t (even? #d+2))
 
717
(assert-eq? (tn) #f (even? #d3))
 
718
(assert-eq? (tn) #f (even? #d-3))
 
719
(assert-eq? (tn) #f (even? #d+3))
 
720
(assert-eq? (tn) #t (even? #d4))
 
721
(assert-eq? (tn) #t (even? #d-4))
 
722
(assert-eq? (tn) #t (even? #d+4))
 
723
;; hexadecimal
 
724
(assert-eq? (tn) #t (even? #x0))
 
725
(assert-eq? (tn) #t (even? #x-0))
 
726
(assert-eq? (tn) #t (even? #x+0))
 
727
(assert-eq? (tn) #f (even? #x1))
 
728
(assert-eq? (tn) #f (even? #x-1))
 
729
(assert-eq? (tn) #f (even? #x+1))
 
730
(assert-eq? (tn) #t (even? #x2))
 
731
(assert-eq? (tn) #t (even? #x-2))
 
732
(assert-eq? (tn) #t (even? #x+2))
 
733
(assert-eq? (tn) #f (even? #x3))
 
734
(assert-eq? (tn) #f (even? #x-3))
 
735
(assert-eq? (tn) #f (even? #x+3))
 
736
(assert-eq? (tn) #t (even? #x4))
 
737
(assert-eq? (tn) #t (even? #x-4))
 
738
(assert-eq? (tn) #t (even? #x+4))
 
739
(assert-eq? (tn) #t (even? #xa))
 
740
(assert-eq? (tn) #t (even? #x-a))
 
741
(assert-eq? (tn) #t (even? #x+a))
 
742
(assert-eq? (tn) #f (even? #xb))
 
743
(assert-eq? (tn) #f (even? #x-b))
 
744
(assert-eq? (tn) #f (even? #x+b))
 
745
 
 
746
(assert-error (tn) (lambda () (even? 'symbol)))
 
747
(assert-error (tn) (lambda () (even? 'SYMBOL)))
 
748
(assert-error (tn) (lambda () (even? #\a)))
 
749
(assert-error (tn) (lambda () (even? #\あ)))
 
750
(assert-error (tn) (lambda () (even? "")))
 
751
(assert-error (tn) (lambda () (even? " ")))
 
752
(assert-error (tn) (lambda () (even? "a")))
 
753
(assert-error (tn) (lambda () (even? "A")))
 
754
(assert-error (tn) (lambda () (even? "aBc12!")))
 
755
(assert-error (tn) (lambda () (even? "あ")))
 
756
(assert-error (tn) (lambda () (even? "あ0イう12!")))
 
757
(assert-error (tn) (lambda () (even? +)))
 
758
(assert-error (tn) (lambda () (even? (lambda () #t))))
 
759
 
 
760
;; syntactic keywords should not be appeared as operand
 
761
(if sigscheme?
 
762
    (begin
 
763
      ;; pure syntactic keyword
 
764
      (assert-error (tn) (lambda () (even? else)))
 
765
      ;; expression keyword
 
766
      (assert-error (tn) (lambda () (even? do)))))
 
767
 
 
768
(call-with-current-continuation
 
769
 (lambda (k)
 
770
   (assert-error (tn) (lambda () (even? k)))))
 
771
(assert-error (tn) (lambda () (even? (current-output-port))))
 
772
(assert-error (tn) (lambda () (even? '(#t . #t))))
 
773
(assert-error (tn) (lambda () (even? (cons #t #t))))
 
774
(assert-error (tn) (lambda () (even? '(0 1 2))))
 
775
(assert-error (tn) (lambda () (even? (list 0 1 2))))
 
776
(assert-error (tn) (lambda () (even? '#())))
 
777
(assert-error (tn) (lambda () (even? (vector))))
 
778
(assert-error (tn) (lambda () (even? '#(0 1 2))))
 
779
(assert-error (tn) (lambda () (even? (vector 0 1 2))))
 
780
 
 
781
 
 
782
(total-report)