Ticket #874: srfi-14-test.scm

File srfi-14-test.scm, 10.1 KB (added by Mario Domenech Goulart, 14 years ago)

srfi-14-test.scm

Line 
1(use srfi-14)
2(use (only srfi-1 remove))
3(define remv delete)
4
5(define (writeln . xs)
6 (for-each display xs)
7 (newline))
8
9(define (fail token . more)
10 (writeln "Error: test failed: " token)
11 #f)
12
13(or (equal? #t (char-set? (char-set)))
14 (fail 'char-set?:1))
15(or (equal? #t (char-set? (string->char-set "abcde")))
16 (fail 'char-set?:2))
17(or (equal? #f (char-set? 37))
18 (fail 'char-set?:3))
19(or (equal? #f (char-set? "abcde"))
20 (fail 'char-set?:4))
21
22(or (equal? #t (char-set= (char-set) (char-set)))
23 (fail 'char-set=:1))
24(or (equal? #t (char-set= (char-set #\a #\b #\c) (char-set #\c #\b #\a)))
25 (fail 'char-set=:2))
26(or (equal? #f (char-set= (char-set #\a #\b #\c) (char-set #\c #\d #\a)))
27 (fail 'char-set=:3))
28(or (equal? #t (char-set=))
29 (fail 'char-set=:4))
30(or (equal? #t (char-set= (char-set)))
31 (fail 'char-set=:5))
32
33(or (equal? #t (char-set<= (char-set) (char-set)))
34 (fail 'char-set<=:1))
35(or (equal? #t (char-set<= (char-set #\a #\b) (char-set #\a #\b #\c)))
36 (fail 'char-set<=:2))
37(or (equal? #f (char-set<= (char-set #\a #\b #\c) (char-set #\a #\b)))
38 (fail 'char-set<=:3))
39(or (equal? #t (char-set<=))
40 (fail 'char-set<=:4))
41(or (equal? #t (char-set<= (char-set)))
42 (fail 'char-set<=:5))
43
44(or (let ((h (char-set-hash (char-set #\a #\b #\c) 3737)))
45 (and (<= 0 h) (< h 3737)))
46 (fail 'char-set-hash:1))
47(or (equal? (char-set-hash (char-set #\a #\b #\c))
48 (char-set-hash (char-set #\b #\c #\a)))
49 (fail 'char-set-hash:2))
50
51(or (equal? '(#\G #\T #\a #\c #\e #\h)
52 (let ((cs (char-set #\G #\a #\T #\e #\c #\h)))
53 (let lp ((cur (char-set-cursor cs)) (ans '()))
54 (if (end-of-char-set? cur) ans
55 (lp (char-set-cursor-next cs cur)
56 (cons (char-set-ref cs cur) ans))))))
57 (fail 'char-set-cursor:1))
58
59(or (let ((ms (char-set-fold cons '() (char-set #\a #\b #\c #\T))))
60 (and (memv #\a ms)
61 (memv #\b ms)
62 (memv #\c ms)
63 (memv #\T ms)
64 (= (length ms) 4)))
65 (fail 'char-set-fold:1))
66
67(or (char-set= (char-set-unfold null? car cdr (string->list "abracadabra"))
68 (string->char-set "abracadabra"))
69 (fail 'char-set-unfold:1))
70(or (char-set= (char-set-unfold null? car cdr (string->list "abracadabra") (char-set #\f))
71 (string->char-set "abracadabraf"))
72 (fail 'char-set-unfold:2))
73(or (char-set= (char-set-unfold! null? car cdr (string->list "abracadabra") (char-set #\f))
74 (string->char-set "abracadabraf"))
75 (fail 'char-set-unfold!:1))
76
77(or (let ((chars (string->list "fnord")))
78 (null? (begin
79 (char-set-for-each (lambda (c)
80 (if (not (memv c chars))
81 (fail 'char-set-for-each:0))
82 (set! chars (remv c chars)))
83 (list->char-set chars))
84 chars)))
85 (fail 'char-set-for-each:1))
86
87(or (let ((chars (string->list "fnord")))
88 (let ((newchars (char-set-map (lambda (c)
89 (if (not (memv c chars))
90 (fail 'char-set-map:0))
91 (set! chars (remv c chars))
92 c)
93 (list->char-set chars))))
94 (char-set= (string->char-set "fnord") newchars)))
95 (fail 'char-set-map:1))
96
97; ...
98
99; Shivers's tests.
100
101(let-syntax ((test (syntax-rules ()
102 ((test form ...)
103 (cond ((begin
104 ;(writeln 'form)
105 (not form))
106 (fail "Test failed" 'form)) ...
107 (else 'OK))))))
108 (let ((vowel? (lambda (c)
109 (member c '(#\a #\e #\i #\o #\u)))))
110 (test
111 (not (char-set? 5))
112
113 (char-set? (char-set #\a #\e #\i #\o #\u))
114
115 (char-set=)
116 (char-set= (char-set))
117
118 (char-set= (char-set #\a #\e #\i #\o #\u)
119 (string->char-set "ioeauaiii"))
120
121 (not (char-set= (char-set #\e #\i #\o #\u)
122 (string->char-set "ioeauaiii")))
123
124 (char-set<=)
125 (char-set<= (char-set))
126
127 (char-set<= (char-set #\a #\e #\i #\o #\u)
128 (string->char-set "ioeauaiii"))
129
130 (char-set<= (char-set #\e #\i #\o #\u)
131 (string->char-set "ioeauaiii"))
132
133 (<= 0 (char-set-hash char-set:graphic 100) 99)
134
135 (= 4 (char-set-fold (lambda (c i) (+ i 1)) 0
136 (char-set #\e #\i #\o #\u #\e #\e)))
137
138 (char-set= (string->char-set "eiaou2468013579999")
139 (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u #\u #\u)
140 char-set:digit))
141
142 (char-set= (string->char-set "eiaou246801357999")
143 (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
144 (string->char-set "0123456789")))
145
146 (not (char-set= (string->char-set "eiaou246801357")
147 (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
148 (string->char-set "0123456789"))))
149
150 (let ((cs (string->char-set "0123456789")))
151 (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
152 (string->char-set "02468000"))
153 (char-set= cs (string->char-set "97531")))
154
155 (not (let ((cs (string->char-set "0123456789")))
156 (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
157 (string->char-set "02468"))
158 (char-set= cs (string->char-set "7531"))))
159
160 (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
161 (string->char-set "IOUAEEEE"))
162
163 (not (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
164 (string->char-set "OUAEEEE")))
165
166 (char-set= (char-set-copy (string->char-set "aeiou"))
167 (string->char-set "aeiou"))
168
169 (char-set= (char-set #\x #\y) (string->char-set "xy"))
170 (not (char-set= (char-set #\x #\y #\z) (string->char-set "xy")))
171
172 (char-set= (string->char-set "xy") (list->char-set '(#\x #\y)))
173 (not (char-set= (string->char-set "axy") (list->char-set '(#\x #\y))))
174
175 (char-set= (string->char-set "xy12345")
176 (list->char-set '(#\x #\y) (string->char-set "12345")))
177 (not (char-set= (string->char-set "y12345")
178 (list->char-set '(#\x #\y) (string->char-set "12345"))))
179
180 (char-set= (string->char-set "xy12345")
181 (list->char-set! '(#\x #\y) (string->char-set "12345")))
182 (not (char-set= (string->char-set "y12345")
183 (list->char-set! '(#\x #\y) (string->char-set "12345"))))
184
185 (char-set= (string->char-set "aeiou12345")
186 (char-set-filter vowel? char-set:ascii (string->char-set "12345")))
187 (not (char-set= (string->char-set "aeou12345")
188 (char-set-filter vowel? char-set:ascii (string->char-set "12345"))))
189
190 (char-set= (string->char-set "aeiou12345")
191 (char-set-filter! vowel? char-set:ascii (string->char-set "12345")))
192 (not (char-set= (string->char-set "aeou12345")
193 (char-set-filter! vowel? char-set:ascii (string->char-set "12345"))))
194
195
196 (char-set= (string->char-set "abcdef12345")
197 (ucs-range->char-set 97 103 #t (string->char-set "12345")))
198 (not (char-set= (string->char-set "abcef12345")
199 (ucs-range->char-set 97 103 #t (string->char-set "12345"))))
200
201 (char-set= (string->char-set "abcdef12345")
202 (ucs-range->char-set! 97 103 #t (string->char-set "12345")))
203 (not (char-set= (string->char-set "abcef12345")
204 (ucs-range->char-set! 97 103 #t (string->char-set "12345"))))
205
206
207 (char-set= (->char-set #\x)
208 (->char-set "x")
209 (->char-set (char-set #\x)))
210
211 (not (char-set= (->char-set #\x)
212 (->char-set "y")
213 (->char-set (char-set #\x))))
214
215 (= 10 (char-set-size (char-set-intersection char-set:ascii char-set:digit)))
216
217 (= 5 (char-set-count vowel? char-set:ascii))
218
219 (equal? '(#\x) (char-set->list (char-set #\x)))
220 (not (equal? '(#\X) (char-set->list (char-set #\x))))
221
222 (equal? "x" (char-set->string (char-set #\x)))
223 (not (equal? "X" (char-set->string (char-set #\x))))
224
225 (char-set-contains? (->char-set "xyz") #\x)
226 (not (char-set-contains? (->char-set "xyz") #\a))
227
228 (char-set-every char-lower-case? (->char-set "abcd"))
229 (not (char-set-every char-lower-case? (->char-set "abcD")))
230 (char-set-any char-lower-case? (->char-set "abcd"))
231 (not (char-set-any char-lower-case? (->char-set "ABCD")))
232
233 (char-set= (->char-set "ABCD")
234 (let ((cs (->char-set "abcd")))
235 (let lp ((cur (char-set-cursor cs)) (ans '()))
236 (if (end-of-char-set? cur) (list->char-set ans)
237 (lp (char-set-cursor-next cs cur)
238 (cons (char-upcase (char-set-ref cs cur)) ans))))))
239
240
241 (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
242 (->char-set "123xa"))
243 (not (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
244 (->char-set "123x")))
245 (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
246 (->char-set "123xa"))
247 (not (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
248 (->char-set "123x")))
249
250 (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
251 (->char-set "13"))
252 (not (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
253 (->char-set "13a")))
254 (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
255 (->char-set "13"))
256 (not (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
257 (->char-set "13a")))
258
259 (char-set= (char-set-intersection char-set:hex-digit (char-set-complement char-set:digit))
260 (->char-set "abcdefABCDEF"))
261 (char-set= (char-set-intersection! (char-set-complement! (->char-set "0123456789"))
262 char-set:hex-digit)
263 (->char-set "abcdefABCDEF"))
264
265 (char-set= (char-set-union char-set:hex-digit
266 (->char-set "abcdefghijkl"))
267 (->char-set "abcdefABCDEFghijkl0123456789"))
268 (char-set= (char-set-union! (->char-set "abcdefghijkl")
269 char-set:hex-digit)
270 (->char-set "abcdefABCDEFghijkl0123456789"))
271
272 (char-set= (char-set-difference (->char-set "abcdefghijklmn")
273 char-set:hex-digit)
274 (->char-set "ghijklmn"))
275 (char-set= (char-set-difference! (->char-set "abcdefghijklmn")
276 char-set:hex-digit)
277 (->char-set "ghijklmn"))
278
279 (char-set= (char-set-xor (->char-set "0123456789")
280 char-set:hex-digit)
281 (->char-set "abcdefABCDEF"))
282 (char-set= (char-set-xor! (->char-set "0123456789")
283 char-set:hex-digit)
284 (->char-set "abcdefABCDEF"))
285
286 (call-with-values (lambda ()
287 (char-set-diff+intersection char-set:hex-digit
288 char-set:letter))
289 (lambda (d i)
290 (and (char-set= d (->char-set "0123456789"))
291 (char-set= i (->char-set "abcdefABCDEF")))))
292
293 (call-with-values (lambda ()
294 (char-set-diff+intersection! (char-set-copy char-set:hex-digit)
295 (char-set-copy char-set:letter)))
296 (lambda (d i)
297 (and (char-set= d (->char-set "0123456789"))
298 (char-set= i (->char-set "abcdefABCDEF"))))))
299
300 ))