Commit | Line | Data |
---|---|---|
55b44a9e GB |
1 | ;;;; chars.test --- test suite for Guile's char functions -*- scheme -*- |
2 | ;;;; Greg J. Badros <gjb@cs.washington.edu> | |
3 | ;;;; | |
1893df41 | 4 | ;;;; Copyright (C) 2000, 2006, 2009 Free Software Foundation, Inc. |
55b44a9e | 5 | ;;;; |
53befeb7 NJ |
6 | ;;;; This library is free software; you can redistribute it and/or |
7 | ;;;; modify it under the terms of the GNU Lesser General Public | |
8 | ;;;; License as published by the Free Software Foundation; either | |
9 | ;;;; version 3 of the License, or (at your option) any later version. | |
55b44a9e | 10 | ;;;; |
53befeb7 | 11 | ;;;; This library is distributed in the hope that it will be useful, |
55b44a9e | 12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
53befeb7 NJ |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
14 | ;;;; Lesser General Public License for more details. | |
55b44a9e | 15 | ;;;; |
53befeb7 NJ |
16 | ;;;; You should have received a copy of the GNU Lesser General Public |
17 | ;;;; License along with this library; if not, write to the Free Software | |
18 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
47dbd81e | 19 | |
1b34e26a NJ |
20 | (use-modules (test-suite lib)) |
21 | ||
22 | (define exception:wrong-type-to-apply | |
23 | (cons 'misc-error "^Wrong type to apply:")) | |
24 | ||
25 | ||
47dbd81e DH |
26 | (with-test-prefix "basic char handling" |
27 | ||
28 | (with-test-prefix "evaluator" | |
29 | ||
f5c6ec2f | 30 | ;; The following test makes sure that the evaluator distinguishes between |
47dbd81e DH |
31 | ;; evaluator-internal instruction codes and characters. |
32 | (pass-if-exception "evaluating chars" | |
33 | exception:wrong-type-to-apply | |
1893df41 | 34 | (eval '(#\0) (interaction-environment)))) |
47dbd81e | 35 | |
1893df41 | 36 | (with-test-prefix "comparisons" |
55b44a9e | 37 | |
1893df41 MG |
38 | ;; char=? |
39 | (pass-if "char=? #\\A #\\A" | |
40 | (char=? #\A #\A)) | |
41 | ||
42 | (expect-fail "char=? #\\A #\\a" | |
43 | (char=? #\A #\a)) | |
44 | ||
45 | (expect-fail "char=? #\\A #\\B" | |
46 | (char=? #\A #\B)) | |
47 | ||
48 | (expect-fail "char=? #\\B #\\A" | |
49 | (char=? #\A #\B)) | |
50 | ||
51 | ;; char<? | |
52 | (expect-fail "char<? #\\A #\\A" | |
53 | (char<? #\A #\A)) | |
54 | ||
55 | (pass-if "char<? #\\A #\\a" | |
56 | (char<? #\A #\a)) | |
57 | ||
58 | (pass-if "char<? #\\A #\\B" | |
59 | (char<? #\A #\B)) | |
60 | ||
61 | (expect-fail "char<? #\\B #\\A" | |
62 | (char<? #\B #\A)) | |
63 | ||
64 | ;; char<=? | |
65 | (pass-if "char<=? #\\A #\\A" | |
66 | (char<=? #\A #\A)) | |
67 | ||
68 | (pass-if "char<=? #\\A #\\a" | |
69 | (char<=? #\A #\a)) | |
70 | ||
71 | (pass-if "char<=? #\\A #\\B" | |
72 | (char<=? #\A #\B)) | |
73 | ||
74 | (expect-fail "char<=? #\\B #\\A" | |
75 | (char<=? #\B #\A)) | |
76 | ||
77 | ;; char>? | |
78 | (expect-fail "char>? #\\A #\\A" | |
79 | (char>? #\A #\A)) | |
80 | ||
81 | (expect-fail "char>? #\\A #\\a" | |
82 | (char>? #\A #\a)) | |
83 | ||
84 | (expect-fail "char>? #\\A #\\B" | |
85 | (char>? #\A #\B)) | |
86 | ||
87 | (pass-if "char>? #\\B #\\A" | |
88 | (char>? #\B #\A)) | |
89 | ||
90 | ;; char>=? | |
91 | (pass-if "char>=? #\\A #\\A" | |
92 | (char>=? #\A #\A)) | |
93 | ||
94 | (expect-fail "char>=? #\\A #\\a" | |
95 | (char>=? #\A #\a)) | |
96 | ||
97 | (expect-fail "char>=? #\\A #\\B" | |
98 | (char>=? #\A #\B)) | |
99 | ||
100 | (pass-if "char>=? #\\B #\\A" | |
101 | (char>=? #\B #\A)) | |
102 | ||
103 | ;; char-ci=? | |
104 | (pass-if "char-ci=? #\\A #\\A" | |
105 | (char-ci=? #\A #\A)) | |
106 | ||
107 | (pass-if "char-ci=? #\\A #\\a" | |
108 | (char-ci=? #\A #\a)) | |
109 | ||
110 | (expect-fail "char-ci=? #\\A #\\B" | |
111 | (char-ci=? #\A #\B)) | |
112 | ||
113 | (expect-fail "char-ci=? #\\B #\\A" | |
114 | (char-ci=? #\A #\B)) | |
115 | ||
116 | ;; char-ci<? | |
117 | (expect-fail "char-ci<? #\\A #\\A" | |
118 | (char-ci<? #\A #\A)) | |
119 | ||
120 | (expect-fail "char-ci<? #\\A #\\a" | |
121 | (char-ci<? #\A #\a)) | |
122 | ||
123 | (pass-if "char-ci<? #\\A #\\B" | |
124 | (char-ci<? #\A #\B)) | |
125 | ||
126 | (expect-fail "char-ci<? #\\B #\\A" | |
127 | (char-ci<? #\B #\A)) | |
128 | ||
129 | ;; char-ci<=? | |
130 | (pass-if "char-ci<=? #\\A #\\A" | |
131 | (char-ci<=? #\A #\A)) | |
132 | ||
133 | (pass-if "char-ci<=? #\\A #\\a" | |
134 | (char-ci<=? #\A #\a)) | |
135 | ||
136 | (pass-if "char-ci<=? #\\A #\\B" | |
137 | (char-ci<=? #\A #\B)) | |
138 | ||
139 | (expect-fail "char-ci<=? #\\B #\\A" | |
140 | (char-ci<=? #\B #\A)) | |
141 | ||
142 | ;; char-ci>? | |
143 | (expect-fail "char-ci>? #\\A #\\A" | |
144 | (char-ci>? #\A #\A)) | |
145 | ||
146 | (expect-fail "char-ci>? #\\A #\\a" | |
147 | (char-ci>? #\A #\a)) | |
148 | ||
149 | (expect-fail "char-ci>? #\\A #\\B" | |
150 | (char-ci>? #\A #\B)) | |
151 | ||
152 | (pass-if "char-ci>? #\\B #\\A" | |
153 | (char-ci>? #\B #\A)) | |
154 | ||
155 | ;; char-ci>=? | |
156 | (pass-if "char-ci>=? #\\A #\\A" | |
157 | (char-ci>=? #\A #\A)) | |
158 | ||
159 | (pass-if "char-ci>=? #\\A #\\a" | |
160 | (char-ci>=? #\A #\a)) | |
161 | ||
162 | (expect-fail "char-ci>=? #\\A #\\B" | |
163 | (char-ci>=? #\A #\B)) | |
164 | ||
165 | (pass-if "char-ci>=? #\\B #\\A" | |
166 | (char-ci>=? #\B #\A))) | |
167 | ||
168 | (with-test-prefix "categories" | |
169 | ||
170 | (pass-if "char-alphabetic?" | |
171 | (and (char-alphabetic? #\a) | |
172 | (char-alphabetic? #\A) | |
173 | (not (char-alphabetic? #\1)) | |
174 | (not (char-alphabetic? #\+)))) | |
175 | ||
176 | (pass-if "char-numeric?" | |
177 | (and (not (char-numeric? #\a)) | |
178 | (not (char-numeric? #\A)) | |
179 | (char-numeric? #\1) | |
180 | (not (char-numeric? #\+)))) | |
181 | ||
182 | (pass-if "char-whitespace?" | |
183 | (and (not (char-whitespace? #\a)) | |
184 | (not (char-whitespace? #\A)) | |
185 | (not (char-whitespace? #\1)) | |
186 | (char-whitespace? #\space) | |
187 | (not (char-whitespace? #\+)))) | |
188 | ||
189 | (pass-if "char-upper-case?" | |
190 | (and (not (char-upper-case? #\a)) | |
191 | (char-upper-case? #\A) | |
192 | (not (char-upper-case? #\1)) | |
193 | (not (char-upper-case? #\+)))) | |
194 | ||
195 | (pass-if "char-lower-case?" | |
196 | (and (char-lower-case? #\a) | |
197 | (not (char-lower-case? #\A)) | |
198 | (not (char-lower-case? #\1)) | |
199 | (not (char-lower-case? #\+)))) | |
200 | ||
201 | (pass-if "char-is-both? works" | |
202 | (and | |
203 | (not (char-is-both? #\?)) | |
204 | (not (char-is-both? #\newline)) | |
205 | (char-is-both? #\a) | |
206 | (char-is-both? #\Z) | |
207 | (not (char-is-both? #\1))))) | |
208 | ||
209 | (with-test-prefix "integer" | |
210 | ||
211 | (pass-if "char->integer" | |
212 | (eqv? (char->integer #\A) 65)) | |
213 | ||
214 | (pass-if "integer->char" | |
215 | (eqv? (integer->char 65) #\A)) | |
216 | ||
217 | (pass-if-exception "integer->char out of range, -1" exception:out-of-range | |
218 | (integer->char -1)) | |
219 | ||
220 | (pass-if-exception "integer->char out of range, surrrogate" exception:out-of-range | |
221 | (integer->char #xd800)) | |
222 | ||
223 | (pass-if-exception "integer->char out of range, 0x110000" exception:out-of-range | |
224 | (integer->char #x110000))) | |
225 | ||
226 | (with-test-prefix "case" | |
227 | ||
228 | (pass-if "char-upcase" | |
229 | (eqv? (char-upcase #\a) #\A)) | |
230 | ||
231 | (pass-if "char-downcase" | |
232 | (eqv? (char-downcase #\A) #\a))) | |
233 | ||
234 | (with-test-prefix "charnames" | |
235 | ||
236 | (pass-if "R5RS character names are case insensitive" | |
237 | (and (eqv? #\space #\ ) | |
238 | (eqv? #\SPACE #\ ) | |
239 | (eqv? #\Space #\ ) | |
240 | (eqv? #\newline (integer->char 10)) | |
241 | (eqv? #\NEWLINE (integer->char 10)) | |
242 | (eqv? #\Newline (integer->char 10)))) | |
243 | ||
244 | (pass-if "C0 control names are case insensitive" | |
245 | (and (eqv? #\nul #\000) | |
246 | (eqv? #\soh #\001) | |
247 | (eqv? #\stx #\002) | |
248 | (eqv? #\NUL #\000) | |
249 | (eqv? #\SOH #\001) | |
250 | (eqv? #\STX #\002) | |
251 | (eqv? #\Nul #\000) | |
252 | (eqv? #\Soh #\001) | |
253 | (eqv? #\Stx #\002))) | |
254 | ||
255 | (pass-if "alt charnames are case insensitive" | |
256 | (eqv? #\null #\nul) | |
257 | (eqv? #\NULL #\nul) | |
258 | (eqv? #\Null #\nul)))) |