1 ;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*-
3 ;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011, 2012,
4 ;;;; 2013 Free Software Foundation, Inc.
7 ;;;; This library is free software; you can redistribute it and/or
8 ;;;; modify it under the terms of the GNU Lesser General Public
9 ;;;; License as published by the Free Software Foundation; either
10 ;;;; version 3 of the License, or (at your option) any later version.
12 ;;;; This library is distributed in the hope that it will be useful,
13 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;;;; Lesser General Public License for more details.
17 ;;;; You should have received a copy of the GNU Lesser General Public
18 ;;;; License along with this library; if not, write to the Free Software
19 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 (define-module (test-suite i18n)
22 #:use-module (ice-9 i18n)
23 #:use-module (ice-9 format)
24 #:use-module (srfi srfi-1)
25 #:use-module (test-suite lib))
27 ;; Start from a pristine locale state.
28 (setlocale LC_ALL "C")
30 (define exception:locale-error
31 (cons 'system-error "Failed to install locale"))
35 (with-test-prefix "locale objects"
37 (pass-if "make-locale (2 args)"
38 (not (not (make-locale LC_ALL "C"))))
40 (pass-if "make-locale (2 args, list)"
41 (not (not (make-locale (list LC_COLLATE LC_MESSAGES) "C"))))
43 (pass-if "make-locale (3 args)"
44 (not (not (make-locale (list LC_COLLATE) "C"
45 (make-locale (list LC_MESSAGES) "C")))))
47 (pass-if-exception "make-locale with unknown locale" exception:locale-error
48 (make-locale LC_ALL "does-not-exist"))
51 (and (locale? (make-locale (list LC_ALL) "C"))
52 (locale? (make-locale (list LC_MESSAGES LC_NUMERIC) "C"
53 (make-locale (list LC_CTYPE) "C")))))
55 (pass-if "%global-locale"
56 (and (locale? %global-locale))
57 (locale? (make-locale (list LC_MONETARY) "C"
62 (with-test-prefix "text collation (English)"
64 (pass-if "string-locale<?"
65 (and (string-locale<? "hello" "world")
66 (string-locale<? "hello" "world"
67 (make-locale (list LC_COLLATE) "C"))))
69 (pass-if "char-locale<?"
70 (and (char-locale<? #\a #\b)
71 (char-locale<? #\a #\b (make-locale (list LC_COLLATE) "C"))))
73 (pass-if "string-locale-ci=?"
74 (and (string-locale-ci=? "Hello" "HELLO")
75 (string-locale-ci=? "Hello" "HELLO"
76 (make-locale (list LC_COLLATE) "C"))))
78 (pass-if "string-locale-ci<?"
79 (and (string-locale-ci<? "hello" "WORLD")
80 (string-locale-ci<? "hello" "WORLD"
81 (make-locale (list LC_COLLATE) "C")))))
84 (define %french-locale-name
87 (define %french-utf8-locale-name
90 (define %turkish-utf8-locale-name
93 (define %german-utf8-locale-name
96 (define %greek-utf8-locale-name
99 (define %american-english-locale-name
102 (define %french-locale
104 (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
105 %french-locale-name)))
107 (define %french-utf8-locale
109 (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
110 %french-utf8-locale-name)))
112 (define %german-utf8-locale
115 %german-utf8-locale-name)))
117 (define %greek-utf8-locale
120 %greek-utf8-locale-name)))
122 (define %turkish-utf8-locale
125 %turkish-utf8-locale-name)))
127 (define %american-english-locale
130 %american-english-locale-name)))
132 (define (under-locale-or-unresolved locale thunk)
133 ;; On non-GNU systems, an exception may be raised only when the locale is
134 ;; actually used rather than at `make-locale'-time. Thus, we must guard
137 (if (string-contains %host-type "-gnu")
139 (catch 'system-error thunk
141 (throw 'unresolved))))
142 (throw 'unresolved)))
144 (define (under-french-locale-or-unresolved thunk)
145 (under-locale-or-unresolved %french-locale thunk))
147 (define (under-french-utf8-locale-or-unresolved thunk)
148 (under-locale-or-unresolved %french-utf8-locale thunk))
150 (define (under-turkish-utf8-locale-or-unresolved thunk)
151 ;; FreeBSD 8.2 and 9.1, Solaris 2.10, and Darwin 8.11.0 have a broken
152 ;; tr_TR locale where `i' is mapped to uppercase `I' instead of `İ',
153 ;; so disable tests on that platform.
154 (if (or (string-contains %host-type "freebsd8")
155 (string-contains %host-type "freebsd9")
156 (string-contains %host-type "solaris2.10")
157 (string-contains %host-type "darwin8"))
159 (under-locale-or-unresolved %turkish-utf8-locale thunk)))
161 (define (under-german-utf8-locale-or-unresolved thunk)
162 (under-locale-or-unresolved %german-utf8-locale thunk))
164 (define (under-greek-utf8-locale-or-unresolved thunk)
165 (under-locale-or-unresolved %greek-utf8-locale thunk))
167 (define (under-american-english-locale-or-unresolved thunk)
168 (under-locale-or-unresolved %american-english-locale thunk))
171 (with-test-prefix "text collation (French)"
173 (pass-if "string-locale<?"
174 (under-french-locale-or-unresolved
176 (string-locale<? "été" "hiver" %french-locale))))
178 (pass-if "char-locale<?"
179 (under-french-locale-or-unresolved
181 (char-locale<? #\é #\h %french-locale))))
183 (pass-if "string-locale-ci=?"
184 (under-french-locale-or-unresolved
186 (string-locale-ci=? "ÉTÉ" "été" %french-locale))))
188 (pass-if "string-locale-ci=? (2 args, wide strings)"
189 (under-french-utf8-locale-or-unresolved
191 ;; Note: Character `œ' is not part of Latin-1, so these are wide
195 (setlocale LC_ALL "fr_FR.UTF-8"))
197 (string-locale-ci=? "œuf" "ŒUF"))
199 (setlocale LC_ALL "C"))))))
201 (pass-if "string-locale-ci=? (3 args, wide strings)"
202 (under-french-utf8-locale-or-unresolved
204 (string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale))))
206 (pass-if "string-locale-ci<>?"
207 (under-french-locale-or-unresolved
209 (and (string-locale-ci<? "été" "Hiver" %french-locale)
210 (string-locale-ci>? "HiVeR" "été" %french-locale)))))
212 (pass-if "string-locale-ci<>? (wide strings)"
213 (under-french-utf8-locale-or-unresolved
215 ;; One of the strings is UCS-4, the other is Latin-1.
216 (and (string-locale-ci<? "Œdème" "œuf" %french-utf8-locale)
217 (string-locale-ci>? "Œuf" "œdÈMe" %french-utf8-locale)))))
219 (pass-if "string-locale-ci<>? (wide and narrow strings)"
220 (under-french-utf8-locale-or-unresolved
222 ;; One of the strings is UCS-4, the other is Latin-1.
223 (and (string-locale-ci>? "Œdème" "odyssée" %french-utf8-locale)
224 (string-locale-ci<? "Odyssée" "œdème" %french-utf8-locale)))))
226 (pass-if "char-locale-ci<>?"
227 (under-french-locale-or-unresolved
229 (and (char-locale-ci<? #\é #\H %french-locale)
230 (char-locale-ci>? #\h #\É %french-locale)))))
232 (pass-if "char-locale-ci<>? (wide)"
233 (under-french-utf8-locale-or-unresolved
235 (and (char-locale-ci<? #\o #\œ %french-utf8-locale)
236 (char-locale-ci>? #\Œ #\e %french-utf8-locale))))))
239 (with-test-prefix "text collation (German)"
241 (pass-if "string-locale-ci=?"
242 (under-german-utf8-locale-or-unresolved
244 (let ((de (make-locale LC_ALL %german-utf8-locale-name)))
245 (string-locale-ci=? "Straße" "STRASSE"))))))
248 (with-test-prefix "text collation (Greek)"
250 (pass-if "string-locale-ci=?"
251 (under-greek-utf8-locale-or-unresolved
253 (let ((gr (make-locale LC_ALL %greek-utf8-locale-name)))
254 (string-locale-ci=? "ΧΑΟΣ" "χαος" gr))))))
257 (with-test-prefix "character mapping"
259 (pass-if "char-locale-downcase"
260 (and (eqv? #\a (char-locale-downcase #\A))
261 (eqv? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
263 (pass-if "char-locale-upcase"
264 (and (eqv? #\Z (char-locale-upcase #\z))
265 (eqv? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
267 (pass-if "char-locale-titlecase"
268 (and (eqv? #\T (char-locale-titlecase #\t))
269 (eqv? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
271 (pass-if "char-locale-titlecase Dž"
272 (and (eqv? #\762 (char-locale-titlecase #\763))
273 (eqv? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
275 (pass-if "char-locale-upcase Turkish"
276 (under-turkish-utf8-locale-or-unresolved
278 (eqv? #\İ (char-locale-upcase #\i %turkish-utf8-locale)))))
280 (pass-if "char-locale-downcase Turkish"
281 (under-turkish-utf8-locale-or-unresolved
283 (eqv? #\i (char-locale-downcase #\İ %turkish-utf8-locale))))))
286 (with-test-prefix "string mapping"
288 (pass-if "string-locale-downcase"
289 (and (string=? "a" (string-locale-downcase "A"))
290 (string=? "a" (string-locale-downcase "A" (make-locale LC_ALL "C")))))
292 (pass-if "string-locale-upcase"
293 (and (string=? "Z" (string-locale-upcase "z"))
294 (string=? "Z" (string-locale-upcase "z" (make-locale LC_ALL "C")))))
296 (pass-if "string-locale-titlecase"
297 (and (string=? "Hello, World" (string-locale-titlecase "hello, world"))
298 (string=? "Hello, World" (string-locale-titlecase
299 "hello, world" (make-locale LC_ALL "C")))))
301 (pass-if "string-locale-upcase German"
302 (under-german-utf8-locale-or-unresolved
304 (let ((de (make-locale LC_ALL %german-utf8-locale-name)))
306 (string-locale-upcase "Straße" de))))))
308 (pass-if "string-locale-upcase Greek"
309 (under-greek-utf8-locale-or-unresolved
311 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
313 (string-locale-upcase "χαος" el))))))
315 (pass-if "string-locale-upcase Greek (two sigmas)"
316 (under-greek-utf8-locale-or-unresolved
318 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
320 (string-locale-upcase "Γειά σας" el))))))
322 (pass-if "string-locale-downcase Greek"
323 (under-greek-utf8-locale-or-unresolved
325 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
327 (string-locale-downcase "ΧΑΟΣ" el))))))
329 (pass-if "string-locale-downcase Greek (two sigmas)"
330 (under-greek-utf8-locale-or-unresolved
332 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
334 (string-locale-downcase "ΓΕΙΆ ΣΑΣ" el))))))
336 (pass-if "string-locale-upcase Turkish"
337 (under-turkish-utf8-locale-or-unresolved
339 (string=? "İI" (string-locale-upcase "iı" %turkish-utf8-locale)))))
341 (pass-if "string-locale-downcase Turkish"
342 (under-turkish-utf8-locale-or-unresolved
344 (string=? "iı" (string-locale-downcase "İI" %turkish-utf8-locale))))))
347 (with-test-prefix "number parsing"
349 (pass-if "locale-string->integer"
350 (call-with-values (lambda () (locale-string->integer "123"))
351 (lambda (result char-count)
352 (and (equal? result 123)
353 (equal? char-count 3)))))
355 (pass-if "locale-string->inexact"
358 (locale-string->inexact "123.456"
359 (make-locale (list LC_NUMERIC) "C")))
360 (lambda (result char-count)
361 (and (equal? result 123.456)
362 (equal? char-count 7)))))
364 (pass-if "locale-string->inexact (French)"
365 (under-french-locale-or-unresolved
369 (locale-string->inexact "123,456" %french-locale))
370 (lambda (result char-count)
371 (and (equal? result 123.456)
372 (equal? char-count 7))))))))
379 (setlocale LC_ALL "C")
380 (define %c-locale (make-locale LC_ALL "C"))
382 (define %english-days
383 '("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
385 (define (every? . args)
386 (not (not (apply every args))))
389 (with-test-prefix "nl-langinfo et al."
391 (pass-if "locale-day (1 arg)"
394 (map locale-day (map 1+ (iota 7)))))
396 (pass-if "locale-day (2 args)"
400 (locale-day day %c-locale))
403 (pass-if "locale-day (2 args, using `%global-locale')"
407 (locale-day day %global-locale))
410 (pass-if "locale-day (French)"
411 (under-french-locale-or-unresolved
413 (let ((result (locale-day 3 %french-locale)))
414 (and (string? result)
415 (string-ci=? result "mardi"))))))
417 (pass-if "locale-day (French, using `%global-locale')"
418 ;; Make sure `%global-locale' captures the current locale settings as
419 ;; installed using `setlocale'.
420 (under-french-locale-or-unresolved
424 (setlocale LC_TIME %french-locale-name))
426 (let* ((fr (make-locale (list LC_MONETARY) "C" %global-locale))
427 (result (locale-day 3 fr)))
428 (setlocale LC_ALL "C")
429 (and (string? result)
430 (string-ci=? result "mardi"))))
432 (setlocale LC_ALL "C"))))))
434 (pass-if "default locale"
435 ;; Make sure the default locale does not capture the current locale
436 ;; settings as installed using `setlocale'. The default locale should be
438 (under-french-locale-or-unresolved
442 (setlocale LC_ALL %french-locale-name))
444 (let* ((locale (make-locale (list LC_MONETARY) "C"))
445 (result (locale-day 3 locale)))
446 (setlocale LC_ALL "C")
447 (and (string? result)
448 (string-ci=? result "Tuesday"))))
450 (setlocale LC_ALL "C")))))))
457 (with-test-prefix "number->locale-string"
459 ;; We assume the global locale is "C" at this point.
461 (with-test-prefix "C"
463 (pass-if "no thousand separator"
464 ;; Unlike in English, the "C" locale has no thousand separator.
465 ;; If this doesn't hold, the following tests will fail.
466 (string=? "" (locale-thousands-separator)))
469 (string=? "123456" (number->locale-string 123456)))
472 (string=? "1234.567" (number->locale-string 1234.567)))
474 (pass-if "fraction, 1 digit"
475 (string=? "1234.5" (number->locale-string 1234.567 1))))
477 (with-test-prefix "French"
480 (under-french-locale-or-unresolved
482 (let ((fr (make-locale LC_ALL %french-locale-name)))
483 (string=? "123 456" (number->locale-string 123456 #t fr))))))
486 (under-french-locale-or-unresolved
488 (let ((fr (make-locale LC_ALL %french-locale-name)))
489 (string=? "1 234,567" (number->locale-string 1234.567 #t fr))))))
491 (pass-if "fraction, 1 digit"
492 (under-french-locale-or-unresolved
494 (let ((fr (make-locale LC_ALL %french-locale-name)))
496 (number->locale-string 1234.567 1 fr))))))))
498 (with-test-prefix "format ~h"
500 ;; Some systems like Darwin lack the `GROUPING' nl_item, and thus
501 ;; `locale-digit-grouping' defaults to '(); skip the tests in that
504 (with-test-prefix "French"
506 (pass-if "12345.5678"
507 (under-french-locale-or-unresolved
509 (if (null? (locale-digit-grouping %french-locale))
511 (string=? "12 345,6789"
512 (format #f "~:h" 12345.6789 %french-locale)))))))
514 (with-test-prefix "English"
516 (pass-if "12345.5678"
517 (under-american-english-locale-or-unresolved
519 (if (null? (locale-digit-grouping %american-english-locale))
521 (string=? "12,345.6789"
522 (format #f "~:h" 12345.6789
523 %american-english-locale))))))))
525 (with-test-prefix "monetary-amount->locale-string"
527 (with-test-prefix "French"
530 (under-french-locale-or-unresolved
532 (let ((fr (make-locale LC_ALL %french-locale-name)))
533 (string=? "123 456 +EUR"
534 (monetary-amount->locale-string 123456 #f fr))))))
537 (under-french-locale-or-unresolved
539 (let ((fr (make-locale LC_ALL %french-locale-name)))
540 (string=? "1 234,56 EUR "
541 (monetary-amount->locale-string 1234.567 #t fr))))))))