1 ;;;; chars.test --- Characters. -*- coding: utf-8; mode: scheme; -*-
2 ;;;; Greg J. Badros <gjb@cs.washington.edu>
4 ;;;; Copyright (C) 2000, 2006, 2009, 2010 Free Software Foundation, Inc.
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.
11 ;;;; This library is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;;; Lesser General Public License for more details.
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
20 (use-modules (test-suite lib))
22 (define exception:wrong-type-to-apply
23 (cons 'misc-error "^Wrong type to apply:"))
25 (define exception:unknown-character-name
26 (cons #t "unknown character"))
28 (define exception:out-of-range-octal
29 (cons #t "out-of-range"))
32 (with-test-prefix "basic char handling"
34 (with-test-prefix "evaluator"
36 ;; The following test makes sure that the evaluator distinguishes between
37 ;; evaluator-internal instruction codes and characters.
38 (pass-if-exception "evaluating chars"
39 exception:wrong-type-arg
40 (eval '(#\0) (interaction-environment))))
42 (with-test-prefix "comparisons"
45 (pass-if "char=? #\\A #\\A"
48 (pass-if "char=? #\\A #\\a"
49 (not (char=? #\A #\a)))
51 (pass-if "char=? #\\A #\\B"
52 (not (char=? #\A #\B)))
54 (pass-if "char=? #\\B #\\A"
55 (not (char=? #\A #\B)))
58 (pass-if "char<? #\\A #\\A"
59 (not (char<? #\A #\A)))
61 (pass-if "char<? #\\A #\\a"
64 (pass-if "char<? #\\A #\\B"
67 (pass-if "char<? #\\B #\\A"
68 (not (char<? #\B #\A)))
71 (pass-if "char<=? #\\A #\\A"
74 (pass-if "char<=? #\\A #\\a"
77 (pass-if "char<=? #\\A #\\B"
80 (pass-if "char<=? #\\B #\\A"
81 (not (char<=? #\B #\A)))
84 (pass-if "char>? #\\A #\\A"
85 (not (char>? #\A #\A)))
87 (pass-if "char>? #\\A #\\a"
88 (not (char>? #\A #\a)))
90 (pass-if "char>? #\\A #\\B"
91 (not (char>? #\A #\B)))
93 (pass-if "char>? #\\B #\\A"
97 (pass-if "char>=? #\\A #\\A"
100 (pass-if "char>=? #\\A #\\a"
101 (not (char>=? #\A #\a)))
103 (pass-if "char>=? #\\A #\\B"
104 (not (char>=? #\A #\B)))
106 (pass-if "char>=? #\\B #\\A"
110 (pass-if "char-ci=? #\\A #\\A"
113 (pass-if "char-ci=? #\\A #\\a"
116 (pass-if "char-ci=? #\\A #\\B"
117 (not (char-ci=? #\A #\B)))
119 (pass-if "char-ci=? #\\B #\\A"
120 (not (char-ci=? #\A #\B)))
123 (pass-if "char-ci<? #\\A #\\A"
124 (not (char-ci<? #\A #\A)))
126 (pass-if "char-ci<? #\\A #\\a"
127 (not (char-ci<? #\A #\a)))
129 (pass-if "char-ci<? #\\A #\\B"
132 (pass-if "char-ci<? #\\B #\\A"
133 (not (char-ci<? #\B #\A)))
136 (pass-if "char-ci<=? #\\A #\\A"
137 (char-ci<=? #\A #\A))
139 (pass-if "char-ci<=? #\\A #\\a"
140 (char-ci<=? #\A #\a))
142 (pass-if "char-ci<=? #\\A #\\B"
143 (char-ci<=? #\A #\B))
145 (pass-if "char-ci<=? #\\B #\\A"
146 (not (char-ci<=? #\B #\A)))
149 (pass-if "char-ci>? #\\A #\\A"
150 (not (char-ci>? #\A #\A)))
152 (pass-if "char-ci>? #\\A #\\a"
153 (not (char-ci>? #\A #\a)))
155 (pass-if "char-ci>? #\\A #\\B"
156 (not (char-ci>? #\A #\B)))
158 (pass-if "char-ci>? #\\B #\\A"
162 (pass-if "char-ci>=? #\\A #\\A"
163 (char-ci>=? #\A #\A))
165 (pass-if "char-ci>=? #\\A #\\a"
166 (char-ci>=? #\A #\a))
168 (pass-if "char-ci>=? #\\A #\\B"
169 (not (char-ci>=? #\A #\B)))
171 (pass-if "char-ci>=? #\\B #\\A"
172 (char-ci>=? #\B #\A)))
174 (with-test-prefix "categories"
176 (pass-if "char-alphabetic?"
177 (and (char-alphabetic? #\a)
178 (char-alphabetic? #\A)
179 (not (char-alphabetic? #\1))
180 (not (char-alphabetic? #\+))))
182 (pass-if "char-numeric?"
183 (and (not (char-numeric? #\a))
184 (not (char-numeric? #\A))
186 (not (char-numeric? #\+))))
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? #\+))))
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? #\+))))
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? #\+))))
207 (pass-if "char-is-both? works"
209 (not (char-is-both? #\?))
210 (not (char-is-both? #\newline))
213 (not (char-is-both? #\1))))
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))))
220 (with-test-prefix "integer"
222 (pass-if "char->integer"
223 (eqv? (char->integer #\A) 65))
225 (pass-if "integer->char"
226 (eqv? (integer->char 65) #\A))
228 (pass-if-exception "integer->char out of range, -1" exception:out-of-range
231 (pass-if-exception "integer->char out of range, surrrogate"
232 exception:out-of-range
233 (integer->char #xd800))
235 (pass-if-exception "integer->char out of range, too big"
236 exception:out-of-range
237 (integer->char #x110000))
239 (pass-if-exception "octal out of range, surrrogate"
240 exception:out-of-range-octal
241 (with-input-from-string "#\\154000" read))
243 (pass-if-exception "octal out of range, too big"
244 exception:out-of-range-octal
245 (with-input-from-string "#\\4200000" read)))
247 (with-test-prefix "case"
249 (pass-if "char-upcase"
250 (eqv? (char-upcase #\a) #\A))
252 (pass-if "char-downcase"
253 (eqv? (char-downcase #\A) #\a))
255 (pass-if "char-titlecase"
256 (and (eqv? (char-titlecase #\a) #\A)
257 (eqv? (char-titlecase #\763) #\762))))
259 (with-test-prefix "charnames"
261 (pass-if "R5RS character names"
262 (and (eqv? #\space (integer->char #x20))
263 (eqv? #\newline (integer->char #x0A))))
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))))
279 (pass-if "R5RS character names are case insensitive"
280 (and (eqv? #\space #\ )
283 (eqv? #\newline (integer->char 10))
284 (eqv? #\NEWLINE (integer->char 10))
285 (eqv? #\Newline (integer->char 10))))
287 (pass-if "C0 control names are case insensitive"
288 (and (eqv? #\nul #\000)
298 (pass-if "alt charnames are case insensitive"
303 (pass-if-exception "bad charname" exception:unknown-character-name
304 (with-input-from-string "#\\blammo" read))
306 (pass-if "R5RS character names are preferred write format"
308 (with-output-to-string (lambda () (write #\space)))
311 (pass-if "C0 control character names are preferred write format"
313 (with-output-to-string (lambda () (write #\soh)))
316 (pass-if "combining accent is pretty-printed"
317 (let ((accent (integer->char #x030f))) ; COMBINING DOUBLE GRAVE ACCENT
319 (with-fluids ((%default-port-encoding "UTF-8"))
320 (with-output-to-string (lambda () (write accent))))
323 (pass-if "combining X is pretty-printed"
324 (let ((x (integer->char #x0353))) ; COMBINING X BELOW
326 (with-fluids ((%default-port-encoding "UTF-8"))
327 (with-output-to-string (lambda () (write x))))