Commit | Line | Data |
---|---|---|
33d92fe6 | 1 | ;;;; chars.test --- Characters. -*- coding: utf-8; mode: scheme; -*- |
55b44a9e GB |
2 | ;;;; Greg J. Badros <gjb@cs.washington.edu> |
3 | ;;;; | |
6dce942c | 4 | ;;;; Copyright (C) 2000, 2006, 2009, 2010, 2013 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 | ||
6c2353e1 MG |
25 | (define exception:unknown-character-name |
26 | (cons #t "unknown character")) | |
27 | ||
28 | (define exception:out-of-range-octal | |
29 | (cons #t "out-of-range")) | |
30 | ||
1b34e26a | 31 | |
47dbd81e DH |
32 | (with-test-prefix "basic char handling" |
33 | ||
34 | (with-test-prefix "evaluator" | |
35 | ||
f5c6ec2f | 36 | ;; The following test makes sure that the evaluator distinguishes between |
47dbd81e DH |
37 | ;; evaluator-internal instruction codes and characters. |
38 | (pass-if-exception "evaluating chars" | |
b7742c6b | 39 | exception:wrong-type-arg |
1893df41 | 40 | (eval '(#\0) (interaction-environment)))) |
47dbd81e | 41 | |
1893df41 | 42 | (with-test-prefix "comparisons" |
55b44a9e | 43 | |
1893df41 MG |
44 | ;; char=? |
45 | (pass-if "char=? #\\A #\\A" | |
46 | (char=? #\A #\A)) | |
47 | ||
88644a10 MW |
48 | (pass-if "char=? #\\A #\\a" |
49 | (not (char=? #\A #\a))) | |
1893df41 | 50 | |
88644a10 MW |
51 | (pass-if "char=? #\\A #\\B" |
52 | (not (char=? #\A #\B))) | |
1893df41 | 53 | |
88644a10 MW |
54 | (pass-if "char=? #\\B #\\A" |
55 | (not (char=? #\A #\B))) | |
1893df41 MG |
56 | |
57 | ;; char<? | |
88644a10 MW |
58 | (pass-if "char<? #\\A #\\A" |
59 | (not (char<? #\A #\A))) | |
1893df41 MG |
60 | |
61 | (pass-if "char<? #\\A #\\a" | |
62 | (char<? #\A #\a)) | |
63 | ||
64 | (pass-if "char<? #\\A #\\B" | |
65 | (char<? #\A #\B)) | |
66 | ||
88644a10 MW |
67 | (pass-if "char<? #\\B #\\A" |
68 | (not (char<? #\B #\A))) | |
1893df41 MG |
69 | |
70 | ;; char<=? | |
71 | (pass-if "char<=? #\\A #\\A" | |
72 | (char<=? #\A #\A)) | |
73 | ||
74 | (pass-if "char<=? #\\A #\\a" | |
75 | (char<=? #\A #\a)) | |
76 | ||
77 | (pass-if "char<=? #\\A #\\B" | |
78 | (char<=? #\A #\B)) | |
79 | ||
88644a10 MW |
80 | (pass-if "char<=? #\\B #\\A" |
81 | (not (char<=? #\B #\A))) | |
1893df41 MG |
82 | |
83 | ;; char>? | |
88644a10 MW |
84 | (pass-if "char>? #\\A #\\A" |
85 | (not (char>? #\A #\A))) | |
1893df41 | 86 | |
88644a10 MW |
87 | (pass-if "char>? #\\A #\\a" |
88 | (not (char>? #\A #\a))) | |
1893df41 | 89 | |
88644a10 MW |
90 | (pass-if "char>? #\\A #\\B" |
91 | (not (char>? #\A #\B))) | |
1893df41 MG |
92 | |
93 | (pass-if "char>? #\\B #\\A" | |
94 | (char>? #\B #\A)) | |
95 | ||
96 | ;; char>=? | |
97 | (pass-if "char>=? #\\A #\\A" | |
98 | (char>=? #\A #\A)) | |
99 | ||
88644a10 MW |
100 | (pass-if "char>=? #\\A #\\a" |
101 | (not (char>=? #\A #\a))) | |
1893df41 | 102 | |
88644a10 MW |
103 | (pass-if "char>=? #\\A #\\B" |
104 | (not (char>=? #\A #\B))) | |
1893df41 MG |
105 | |
106 | (pass-if "char>=? #\\B #\\A" | |
107 | (char>=? #\B #\A)) | |
108 | ||
109 | ;; char-ci=? | |
110 | (pass-if "char-ci=? #\\A #\\A" | |
111 | (char-ci=? #\A #\A)) | |
112 | ||
113 | (pass-if "char-ci=? #\\A #\\a" | |
114 | (char-ci=? #\A #\a)) | |
115 | ||
88644a10 MW |
116 | (pass-if "char-ci=? #\\A #\\B" |
117 | (not (char-ci=? #\A #\B))) | |
1893df41 | 118 | |
88644a10 MW |
119 | (pass-if "char-ci=? #\\B #\\A" |
120 | (not (char-ci=? #\A #\B))) | |
1893df41 MG |
121 | |
122 | ;; char-ci<? | |
88644a10 MW |
123 | (pass-if "char-ci<? #\\A #\\A" |
124 | (not (char-ci<? #\A #\A))) | |
1893df41 | 125 | |
88644a10 MW |
126 | (pass-if "char-ci<? #\\A #\\a" |
127 | (not (char-ci<? #\A #\a))) | |
1893df41 MG |
128 | |
129 | (pass-if "char-ci<? #\\A #\\B" | |
130 | (char-ci<? #\A #\B)) | |
131 | ||
88644a10 MW |
132 | (pass-if "char-ci<? #\\B #\\A" |
133 | (not (char-ci<? #\B #\A))) | |
1893df41 MG |
134 | |
135 | ;; char-ci<=? | |
136 | (pass-if "char-ci<=? #\\A #\\A" | |
137 | (char-ci<=? #\A #\A)) | |
138 | ||
139 | (pass-if "char-ci<=? #\\A #\\a" | |
140 | (char-ci<=? #\A #\a)) | |
141 | ||
142 | (pass-if "char-ci<=? #\\A #\\B" | |
143 | (char-ci<=? #\A #\B)) | |
144 | ||
88644a10 MW |
145 | (pass-if "char-ci<=? #\\B #\\A" |
146 | (not (char-ci<=? #\B #\A))) | |
1893df41 MG |
147 | |
148 | ;; char-ci>? | |
88644a10 MW |
149 | (pass-if "char-ci>? #\\A #\\A" |
150 | (not (char-ci>? #\A #\A))) | |
1893df41 | 151 | |
88644a10 MW |
152 | (pass-if "char-ci>? #\\A #\\a" |
153 | (not (char-ci>? #\A #\a))) | |
1893df41 | 154 | |
88644a10 MW |
155 | (pass-if "char-ci>? #\\A #\\B" |
156 | (not (char-ci>? #\A #\B))) | |
1893df41 MG |
157 | |
158 | (pass-if "char-ci>? #\\B #\\A" | |
159 | (char-ci>? #\B #\A)) | |
160 | ||
161 | ;; char-ci>=? | |
162 | (pass-if "char-ci>=? #\\A #\\A" | |
163 | (char-ci>=? #\A #\A)) | |
164 | ||
165 | (pass-if "char-ci>=? #\\A #\\a" | |
166 | (char-ci>=? #\A #\a)) | |
167 | ||
88644a10 MW |
168 | (pass-if "char-ci>=? #\\A #\\B" |
169 | (not (char-ci>=? #\A #\B))) | |
1893df41 MG |
170 | |
171 | (pass-if "char-ci>=? #\\B #\\A" | |
172 | (char-ci>=? #\B #\A))) | |
173 | ||
174 | (with-test-prefix "categories" | |
175 | ||
176 | (pass-if "char-alphabetic?" | |
177 | (and (char-alphabetic? #\a) | |
178 | (char-alphabetic? #\A) | |
179 | (not (char-alphabetic? #\1)) | |
180 | (not (char-alphabetic? #\+)))) | |
181 | ||
182 | (pass-if "char-numeric?" | |
183 | (and (not (char-numeric? #\a)) | |
184 | (not (char-numeric? #\A)) | |
185 | (char-numeric? #\1) | |
186 | (not (char-numeric? #\+)))) | |
187 | ||
188 | (pass-if "char-whitespace?" | |
189 | (and (not (char-whitespace? #\a)) | |
190 | (not (char-whitespace? #\A)) | |
191 | (not (char-whitespace? #\1)) | |
192 | (char-whitespace? #\space) | |
193 | (not (char-whitespace? #\+)))) | |
194 | ||
195 | (pass-if "char-upper-case?" | |
196 | (and (not (char-upper-case? #\a)) | |
197 | (char-upper-case? #\A) | |
198 | (not (char-upper-case? #\1)) | |
199 | (not (char-upper-case? #\+)))) | |
200 | ||
201 | (pass-if "char-lower-case?" | |
202 | (and (char-lower-case? #\a) | |
203 | (not (char-lower-case? #\A)) | |
204 | (not (char-lower-case? #\1)) | |
205 | (not (char-lower-case? #\+)))) | |
206 | ||
207 | (pass-if "char-is-both? works" | |
208 | (and | |
209 | (not (char-is-both? #\?)) | |
210 | (not (char-is-both? #\newline)) | |
211 | (char-is-both? #\a) | |
212 | (char-is-both? #\Z) | |
0ca3a342 JG |
213 | (not (char-is-both? #\1)))) |
214 | ||
215 | (pass-if "char-general-category" | |
216 | (and (eq? (char-general-category #\a) 'Ll) | |
217 | (eq? (char-general-category #\A) 'Lu) | |
218 | (eq? (char-general-category #\762) 'Lt)))) | |
1893df41 MG |
219 | |
220 | (with-test-prefix "integer" | |
221 | ||
222 | (pass-if "char->integer" | |
223 | (eqv? (char->integer #\A) 65)) | |
224 | ||
225 | (pass-if "integer->char" | |
226 | (eqv? (integer->char 65) #\A)) | |
227 | ||
228 | (pass-if-exception "integer->char out of range, -1" exception:out-of-range | |
229 | (integer->char -1)) | |
230 | ||
6c2353e1 MG |
231 | (pass-if-exception "integer->char out of range, surrrogate" |
232 | exception:out-of-range | |
1893df41 MG |
233 | (integer->char #xd800)) |
234 | ||
6c2353e1 MG |
235 | (pass-if-exception "integer->char out of range, too big" |
236 | exception:out-of-range | |
237 | (integer->char #x110000)) | |
238 | ||
239 | (pass-if-exception "octal out of range, surrrogate" | |
240 | exception:out-of-range-octal | |
241 | (with-input-from-string "#\\154000" read)) | |
242 | ||
243 | (pass-if-exception "octal out of range, too big" | |
244 | exception:out-of-range-octal | |
245 | (with-input-from-string "#\\4200000" read))) | |
1893df41 MG |
246 | |
247 | (with-test-prefix "case" | |
248 | ||
249 | (pass-if "char-upcase" | |
250 | (eqv? (char-upcase #\a) #\A)) | |
251 | ||
252 | (pass-if "char-downcase" | |
820f33aa JG |
253 | (eqv? (char-downcase #\A) #\a)) |
254 | ||
255 | (pass-if "char-titlecase" | |
256 | (and (eqv? (char-titlecase #\a) #\A) | |
257 | (eqv? (char-titlecase #\763) #\762)))) | |
1893df41 MG |
258 | |
259 | (with-test-prefix "charnames" | |
260 | ||
15b6a6b2 MG |
261 | (pass-if "R5RS character names" |
262 | (and (eqv? #\space (integer->char #x20)) | |
263 | (eqv? #\newline (integer->char #x0A)))) | |
264 | ||
265 | (pass-if "R6RS character names" | |
266 | (and (eqv? #\nul (integer->char #x00)) | |
267 | (eqv? #\alarm (integer->char #x07)) | |
268 | (eqv? #\backspace (integer->char #x08)) | |
269 | (eqv? #\tab (integer->char #x09)) | |
270 | (eqv? #\linefeed (integer->char #x0A)) | |
271 | (eqv? #\newline (integer->char #x0A)) | |
272 | (eqv? #\vtab (integer->char #x0B)) | |
273 | (eqv? #\page (integer->char #x0C)) | |
274 | (eqv? #\return (integer->char #x0D)) | |
275 | (eqv? #\esc (integer->char #x1B)) | |
276 | (eqv? #\space (integer->char #x20)) | |
277 | (eqv? #\delete (integer->char #x7F)))) | |
278 | ||
1893df41 MG |
279 | (pass-if "R5RS character names are case insensitive" |
280 | (and (eqv? #\space #\ ) | |
281 | (eqv? #\SPACE #\ ) | |
282 | (eqv? #\Space #\ ) | |
283 | (eqv? #\newline (integer->char 10)) | |
284 | (eqv? #\NEWLINE (integer->char 10)) | |
285 | (eqv? #\Newline (integer->char 10)))) | |
286 | ||
287 | (pass-if "C0 control names are case insensitive" | |
288 | (and (eqv? #\nul #\000) | |
289 | (eqv? #\soh #\001) | |
290 | (eqv? #\stx #\002) | |
291 | (eqv? #\NUL #\000) | |
292 | (eqv? #\SOH #\001) | |
293 | (eqv? #\STX #\002) | |
294 | (eqv? #\Nul #\000) | |
295 | (eqv? #\Soh #\001) | |
296 | (eqv? #\Stx #\002))) | |
297 | ||
6c2353e1 MG |
298 | (pass-if "alt charnames are case insensitive" |
299 | (eqv? #\null #\nul) | |
300 | (eqv? #\NULL #\nul) | |
301 | (eqv? #\Null #\nul)) | |
302 | ||
303 | (pass-if-exception "bad charname" exception:unknown-character-name | |
304 | (with-input-from-string "#\\blammo" read)) | |
305 | ||
306 | (pass-if "R5RS character names are preferred write format" | |
307 | (string=? | |
308 | (with-output-to-string (lambda () (write #\space))) | |
309 | "#\\space")) | |
310 | ||
311 | (pass-if "C0 control character names are preferred write format" | |
312 | (string=? | |
313 | (with-output-to-string (lambda () (write #\soh))) | |
33d92fe6 LC |
314 | "#\\soh")) |
315 | ||
316 | (pass-if "combining accent is pretty-printed" | |
317 | (let ((accent (integer->char #x030f))) ; COMBINING DOUBLE GRAVE ACCENT | |
318 | (string=? | |
6dce942c | 319 | (with-output-to-string (lambda () (write accent))) |
33d92fe6 LC |
320 | "#\\◌̏"))) |
321 | ||
322 | (pass-if "combining X is pretty-printed" | |
323 | (let ((x (integer->char #x0353))) ; COMBINING X BELOW | |
324 | (string=? | |
6dce942c | 325 | (with-output-to-string (lambda () (write x))) |
33d92fe6 | 326 | "#\\◌͓"))))) |