source: project/release/5/srfi-14/trunk/tests/run.scm @ 34718

Last change on this file since 34718 was 34718, checked in by sjamaan, 21 months ago

release/5: Replace use by import in eggs

File size: 7.7 KB
Line 
1;;; This is a regression testing suite for the SRFI-14 char-set library.
2;;; Olin Shivers
3
4(import srfi-14)
5
6(let-syntax ((test (syntax-rules ()
7                     ((test form ...)
8                      (cond ((not form) (error "Test failed" 'form)) ...
9                            (else 'OK))))))
10  (let ((vowel? (lambda (c) (member c '(#\a #\e #\i #\o #\u)))))
11
12(test
13 (not (char-set? 5))
14
15 (char-set? (char-set #\a #\e #\i #\o #\u))
16
17 (char-set=)
18 (char-set= (char-set))
19
20 (char-set= (char-set #\a #\e #\i #\o #\u)
21            (string->char-set "ioeauaiii"))
22
23 (not (char-set= (char-set #\e #\i #\o #\u)
24                 (string->char-set "ioeauaiii")))
25
26 (char-set<=)
27 (char-set<= (char-set))
28
29 (char-set<= (char-set #\a #\e #\i #\o #\u)
30             (string->char-set "ioeauaiii"))
31
32 (char-set<= (char-set #\e #\i #\o #\u)
33             (string->char-set "ioeauaiii"))
34
35 (<= 0 (char-set-hash char-set:graphic 100) 99)
36
37 (= 4 (char-set-fold (lambda (c i) (+ i 1)) 0
38                     (char-set #\e #\i #\o #\u #\e #\e)))
39
40 (char-set= (string->char-set "eiaou2468013579999")
41            (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u #\u #\u)
42                             char-set:digit))
43
44 (char-set= (string->char-set "eiaou246801357999")
45            (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
46                              (string->char-set "0123456789")))
47
48 (not (char-set= (string->char-set "eiaou246801357")
49                 (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
50                                   (string->char-set "0123456789"))))
51
52 (let ((cs (string->char-set "0123456789")))
53   (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
54                      (string->char-set "02468000"))
55   (char-set= cs (string->char-set "97531")))
56
57 (not (let ((cs (string->char-set "0123456789")))
58        (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
59                           (string->char-set "02468"))
60        (char-set= cs (string->char-set "7531"))))
61
62 (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
63            (string->char-set "IOUAEEEE"))
64
65 (not (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
66                 (string->char-set "OUAEEEE")))
67
68 (char-set= (char-set-copy (string->char-set "aeiou"))
69            (string->char-set "aeiou"))
70
71 (char-set= (char-set #\x #\y) (string->char-set "xy"))
72 (not (char-set= (char-set #\x #\y #\z) (string->char-set "xy")))
73
74 (char-set= (string->char-set "xy") (list->char-set '(#\x #\y)))
75 (not (char-set= (string->char-set "axy") (list->char-set '(#\x #\y))))
76
77 (char-set= (string->char-set "xy12345")
78            (list->char-set '(#\x #\y) (string->char-set "12345")))
79 (not (char-set= (string->char-set "y12345")
80                 (list->char-set '(#\x #\y) (string->char-set "12345"))))
81
82 (char-set= (string->char-set "xy12345")
83            (list->char-set! '(#\x #\y) (string->char-set "12345")))
84 (not (char-set= (string->char-set "y12345")
85                 (list->char-set! '(#\x #\y) (string->char-set "12345"))))
86
87 (char-set= (string->char-set "aeiou12345")
88            (char-set-filter vowel? char-set:ascii (string->char-set "12345")))
89 (not (char-set= (string->char-set "aeou12345")
90                 (char-set-filter vowel? char-set:ascii (string->char-set "12345"))))
91
92 (char-set= (string->char-set "aeiou12345")
93            (char-set-filter! vowel? char-set:ascii (string->char-set "12345")))
94 (not (char-set= (string->char-set "aeou12345")
95                 (char-set-filter! vowel? char-set:ascii (string->char-set "12345"))))
96
97
98 (char-set= (string->char-set "abcdef12345")
99            (ucs-range->char-set 97 103 #t (string->char-set "12345")))
100 (not (char-set= (string->char-set "abcef12345")
101                 (ucs-range->char-set 97 103 #t (string->char-set "12345"))))
102
103 (char-set= (string->char-set "abcdef12345")
104            (ucs-range->char-set! 97 103 #t (string->char-set "12345")))
105 (not (char-set= (string->char-set "abcef12345")
106                 (ucs-range->char-set! 97 103 #t (string->char-set "12345"))))
107
108
109 (char-set= (->char-set #\x)
110            (->char-set "x")
111            (->char-set (char-set #\x)))
112
113 (not (char-set= (->char-set #\x)
114                 (->char-set "y")
115                 (->char-set (char-set #\x))))
116
117 (= 10 (char-set-size (char-set-intersection char-set:ascii char-set:digit)))
118
119 (= 5 (char-set-count vowel? char-set:ascii))
120
121 (equal? '(#\x) (char-set->list (char-set #\x)))
122 (not (equal? '(#\X) (char-set->list (char-set #\x))))
123
124 (equal? "x" (char-set->string (char-set #\x)))
125 (not (equal? "X" (char-set->string (char-set #\x))))
126
127 (char-set-contains? (->char-set "xyz") #\x)
128 (not (char-set-contains? (->char-set "xyz") #\a))
129
130 (char-set-every char-lower-case? (->char-set "abcd"))
131 (not (char-set-every char-lower-case? (->char-set "abcD")))
132 (char-set-any char-lower-case? (->char-set "abcd"))
133 (not (char-set-any char-lower-case? (->char-set "ABCD")))
134
135 (char-set= (->char-set "ABCD")
136            (let ((cs (->char-set "abcd")))
137              (let lp ((cur (char-set-cursor cs)) (ans '()))
138                (if (end-of-char-set? cur) (list->char-set ans)
139                    (lp (char-set-cursor-next cs cur)
140                        (cons (char-upcase (char-set-ref cs cur)) ans))))))
141
142
143 (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
144            (->char-set "123xa"))
145 (not (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
146                 (->char-set "123x")))
147 (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
148            (->char-set "123xa"))
149 (not (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
150                 (->char-set "123x")))
151
152 (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
153            (->char-set "13"))
154 (not (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
155                 (->char-set "13a")))
156 (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
157            (->char-set "13"))
158 (not (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
159                 (->char-set "13a")))
160
161 (char-set= (char-set-intersection char-set:hex-digit (char-set-complement char-set:digit))
162            (->char-set "abcdefABCDEF"))
163 (char-set= (char-set-intersection! (char-set-complement! (->char-set "0123456789"))
164                                    char-set:hex-digit)
165            (->char-set "abcdefABCDEF"))
166
167 (char-set= (char-set-union char-set:hex-digit
168                            (->char-set "abcdefghijkl"))
169            (->char-set "abcdefABCDEFghijkl0123456789"))
170 (char-set= (char-set-union! (->char-set "abcdefghijkl")
171                             char-set:hex-digit)
172            (->char-set "abcdefABCDEFghijkl0123456789"))
173
174 (char-set= (char-set-difference (->char-set "abcdefghijklmn")
175                                 char-set:hex-digit)
176            (->char-set "ghijklmn"))
177 (char-set= (char-set-difference! (->char-set "abcdefghijklmn")
178                                  char-set:hex-digit)
179            (->char-set "ghijklmn"))
180
181 (char-set= (char-set-xor (->char-set "0123456789")
182                          char-set:hex-digit)
183            (->char-set "abcdefABCDEF"))
184 (char-set= (char-set-xor! (->char-set "0123456789")
185                           char-set:hex-digit)
186            (->char-set "abcdefABCDEF"))
187
188 (call-with-values (lambda ()
189                     (char-set-diff+intersection char-set:hex-digit
190                                                 char-set:letter))
191   (lambda (d i)
192     (and (char-set= d (->char-set "0123456789"))
193          (char-set= i (->char-set "abcdefABCDEF")))))
194
195 (call-with-values (lambda ()
196                     (char-set-diff+intersection! (char-set-copy char-set:hex-digit)
197                                                  (char-set-copy char-set:letter)))
198   (lambda (d i)
199     (and (char-set= d (->char-set "0123456789"))
200          (char-set= i (->char-set "abcdefABCDEF"))))))
201
202))
Note: See TracBrowser for help on using the repository browser.