← Back to branch summary

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

« back to all changes in this revision

Viewing changes to sigscheme/test/test-bool.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-bool.scm
 
1
#! /usr/bin/env sscm -C UTF-8
 
2
;; -*- buffer-file-coding-system: utf-8 -*-
 
3
 
 
4
;;  Filename : test-bool.scm
 
5
;;  About    : unit tests for boolean
 
6
;;
 
7
;;  Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.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
;; To sense boolean values accurately, these tests use '(assert-true (if <exp>
 
42
;; #t #f))' form to test a boolean expression instead of '(assert-true <exp>)'
 
43
;; of '(assert-equal? #t <exp>)'.  -- YamaKen 2006-09-07
 
44
(tn "R5RS upper-case boolean literal")
 
45
(if (provided? "sigscheme")
 
46
    (begin
 
47
      ;; not supported by SigScheme
 
48
      (assert-parse-error (tn) "#F")
 
49
      (assert-parse-error (tn) "#T"))
 
50
    (begin
 
51
      (assert-false (tn) (if (string-read "#F") #t #f))
 
52
      (assert-true  (tn) (if (string-read "#T") #t #f))))
 
53
 
 
54
(tn "boolean self-evaluation")
 
55
(assert-true   (tn) (eq? #f '#f))
 
56
(assert-true   (tn) (eq? #t '#t))
 
57
 
 
58
(tn "boolean values")
 
59
(assert-false  (tn) (if #f #t #f))
 
60
(assert-true   (tn) (if #t #t #f))
 
61
(if (and (provided? "sigscheme")
 
62
         (provided? "siod-bugs"))
 
63
    (begin
 
64
      (assert-false (tn) '())
 
65
      (assert-true  (tn) (eq? #f '())))
 
66
    (begin
 
67
      (assert-true  (tn) '())
 
68
      (assert-false (tn) (eq? #f '()))))
 
69
(if (provided? "sigscheme")
 
70
    (begin
 
71
      (assert-true   (tn) (if (eof) #t #f))
 
72
      (assert-true   (tn) (if (undef) #t #f))))
 
73
(assert-true   (tn) (if 0 #t #f))
 
74
(assert-true   (tn) (if 1 #t #f))
 
75
(assert-true   (tn) (if 3 #t #f))
 
76
(assert-true   (tn) (if -1 #t #f))
 
77
(assert-true   (tn) (if -3 #t #f))
 
78
(assert-true   (tn) (if 'symbol #t #f))
 
79
(assert-true   (tn) (if 'SYMBOL #t #f))
 
80
(assert-true   (tn) (if #\a #t #f))
 
81
(assert-true   (tn) (if #\あ #t #f))
 
82
(assert-true   (tn) (if "" #t #f))
 
83
(assert-true   (tn) (if " " #t #f))
 
84
(assert-true   (tn) (if "a" #t #f))
 
85
(assert-true   (tn) (if "A" #t #f))
 
86
(assert-true   (tn) (if "aBc12!" #t #f))
 
87
(assert-true   (tn) (if "あ" #t #f))
 
88
(assert-true   (tn) (if "あ0イう12!" #t #f))
 
89
(assert-true   (tn) (if + #t #f))
 
90
(assert-true   (tn) (if (lambda () #t) #t #f))
 
91
 
 
92
;; syntactic keywords should not be appeared as operand
 
93
(if sigscheme?
 
94
    (begin
 
95
      ;; pure syntactic keyword
 
96
      (assert-error (tn) (lambda () (if else #t #f)))
 
97
      ;; expression keyword
 
98
      (assert-error (tn) (lambda () (if do #t #f)))))
 
99
 
 
100
(call-with-current-continuation
 
101
 (lambda (k)
 
102
   (assert-true   (tn) (if k #t #f))))
 
103
(assert-true   (tn) (if (current-output-port) #t #f))
 
104
(assert-true   (tn) (if '(#t . #t) #t #f))
 
105
(assert-true   (tn) (if (cons #t #t) #t #f))
 
106
(assert-true   (tn) (if '(0 1 2) #t #f))
 
107
(assert-true   (tn) (if (list 0 1 2) #t #f))
 
108
(assert-true   (tn) (if '#() #t #f))
 
109
(assert-true   (tn) (if (vector) #t #f))
 
110
(assert-true   (tn) (if '#(0 1 2) #t #f))
 
111
(assert-true   (tn) (if (vector 0 1 2) #t #f))
 
112
 
 
113
(tn "not")
 
114
;; 'not' must return exact #t
 
115
;; > R5RS: 6.3 Other data types
 
116
;; > `Not' returns #t if obj is false, and returns #f otherwise.
 
117
(assert-eq? (tn) #t (not #f))
 
118
(assert-eq? (tn) #f (not #t))
 
119
(if (and (provided? "sigscheme")
 
120
         (provided? "siod-bugs"))
 
121
    (assert-eq? (tn) #t (not '()))
 
122
    (assert-eq? (tn) #f (not '())))
 
123
(if (provided? "sigscheme")
 
124
    (begin
 
125
      (assert-eq? (tn) #f (not (eof)))
 
126
      (assert-eq? (tn) #f (not (undef)))))
 
127
(assert-eq? (tn) #f (not 0))
 
128
(assert-eq? (tn) #f (not 1))
 
129
(assert-eq? (tn) #f (not 3))
 
130
(assert-eq? (tn) #f (not -1))
 
131
(assert-eq? (tn) #f (not -3))
 
132
(assert-eq? (tn) #f (not 'symbol))
 
133
(assert-eq? (tn) #f (not 'SYMBOL))
 
134
(assert-eq? (tn) #f (not #\a))
 
135
(assert-eq? (tn) #f (not #\あ))
 
136
(assert-eq? (tn) #f (not ""))
 
137
(assert-eq? (tn) #f (not " "))
 
138
(assert-eq? (tn) #f (not "a"))
 
139
(assert-eq? (tn) #f (not "A"))
 
140
(assert-eq? (tn) #f (not "aBc12!"))
 
141
(assert-eq? (tn) #f (not "あ"))
 
142
(assert-eq? (tn) #f (not "あ0イう12!"))
 
143
(assert-eq? (tn) #f (not +))
 
144
(assert-eq? (tn) #f (not (lambda () #t)))
 
145
 
 
146
;; syntactic keywords should not be appeared as operand
 
147
(if sigscheme?
 
148
    (begin
 
149
      ;; pure syntactic keyword
 
150
      (assert-error (tn) (lambda () (not else)))
 
151
      ;; expression keyword
 
152
      (assert-error (tn) (lambda () (not do)))))
 
153
 
 
154
(call-with-current-continuation
 
155
 (lambda (k)
 
156
   (assert-eq? (tn) #f (not k))))
 
157
(assert-eq? (tn) #f (not (current-output-port)))
 
158
(assert-eq? (tn) #f (not '(#t . #t)))
 
159
(assert-eq? (tn) #f (not (cons #t #t)))
 
160
(assert-eq? (tn) #f (not '(0 1 2)))
 
161
(assert-eq? (tn) #f (not (list 0 1 2)))
 
162
(assert-eq? (tn) #f (not '#()))
 
163
(assert-eq? (tn) #f (not (vector)))
 
164
(assert-eq? (tn) #f (not '#(0 1 2)))
 
165
(assert-eq? (tn) #f (not (vector 0 1 2)))
 
166
 
 
167
(tn "boolean?")
 
168
(assert-eq? (tn) #t (boolean? #f))
 
169
(assert-eq? (tn) #t (boolean? #t))
 
170
(if (and (provided? "sigscheme")
 
171
         (provided? "siod-bugs"))
 
172
    (assert-eq? (tn) #t (boolean? '()))
 
173
    (assert-eq? (tn) #f (boolean? '())))
 
174
(if (provided? "sigscheme")
 
175
    (begin
 
176
      (assert-eq? (tn) #f (boolean? (eof)))
 
177
      (assert-eq? (tn) #f (boolean? (undef)))))
 
178
(assert-eq? (tn) #f (boolean? 0))
 
179
(assert-eq? (tn) #f (boolean? 1))
 
180
(assert-eq? (tn) #f (boolean? 3))
 
181
(assert-eq? (tn) #f (boolean? -1))
 
182
(assert-eq? (tn) #f (boolean? -3))
 
183
(assert-eq? (tn) #f (boolean? 'symbol))
 
184
(assert-eq? (tn) #f (boolean? 'SYMBOL))
 
185
(assert-eq? (tn) #f (boolean? #\a))
 
186
(assert-eq? (tn) #f (boolean? #\あ))
 
187
(assert-eq? (tn) #f (boolean? ""))
 
188
(assert-eq? (tn) #f (boolean? " "))
 
189
(assert-eq? (tn) #f (boolean? "a"))
 
190
(assert-eq? (tn) #f (boolean? "A"))
 
191
(assert-eq? (tn) #f (boolean? "aBc12!"))
 
192
(assert-eq? (tn) #f (boolean? "あ"))
 
193
(assert-eq? (tn) #f (boolean? "あ0イう12!"))
 
194
(assert-eq? (tn) #f (boolean? +))
 
195
(assert-eq? (tn) #f (boolean? (lambda () #t)))
 
196
 
 
197
;; syntactic keywords should not be appeared as operand
 
198
(if sigscheme?
 
199
    (begin
 
200
      ;; pure syntactic keyword
 
201
      (assert-error (tn) (lambda () (boolean? else)))
 
202
      ;; expression keyword
 
203
      (assert-error (tn) (lambda () (boolean? do)))))
 
204
 
 
205
(call-with-current-continuation
 
206
 (lambda (k)
 
207
   (assert-eq? (tn) #f (boolean? k))))
 
208
(assert-eq? (tn) #f (boolean? (current-output-port)))
 
209
(assert-eq? (tn) #f (boolean? '(#t . #t)))
 
210
(assert-eq? (tn) #f (boolean? (cons #t #t)))
 
211
(assert-eq? (tn) #f (boolean? '(0 1 2)))
 
212
(assert-eq? (tn) #f (boolean? (list 0 1 2)))
 
213
(assert-eq? (tn) #f (boolean? '#()))
 
214
(assert-eq? (tn) #f (boolean? (vector)))
 
215
(assert-eq? (tn) #f (boolean? '#(0 1 2)))
 
216
(assert-eq? (tn) #f (boolean? (vector 0 1 2)))
 
217
 
 
218
(total-report)