1 ;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*-
3 ;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011, 2012,
4 ;;;; 2013, 2014 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_NUMERIC) "C"))))
43 (pass-if "make-locale (3 args)"
44 (not (not (make-locale (list LC_COLLATE) "C"
45 (make-locale (list LC_NUMERIC) "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_TIME 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")))))
85 (string-contains %host-type "-mingw32"))
87 (define %french-locale-name
92 ;; What we really want for the following locales is that they be Unicode
93 ;; capable, not necessarily UTF-8, which Windows does not provide.
95 (define %french-utf8-locale-name
100 (define %turkish-utf8-locale-name
105 (define %german-utf8-locale-name
110 (define %greek-utf8-locale-name
115 (define %american-english-locale-name
118 (define %french-locale
120 (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
121 %french-locale-name)))
123 (define %french-utf8-locale
125 (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
126 %french-utf8-locale-name)))
128 (define %german-utf8-locale
131 %german-utf8-locale-name)))
133 (define %greek-utf8-locale
136 %greek-utf8-locale-name)))
138 (define %turkish-utf8-locale
141 %turkish-utf8-locale-name)))
143 (define %american-english-locale
146 %american-english-locale-name)))
148 (define (under-locale-or-unresolved locale thunk)
149 ;; On non-GNU systems, an exception may be raised only when the locale is
150 ;; actually used rather than at `make-locale'-time. Thus, we must guard
153 (if (string-contains %host-type "-gnu")
155 (catch 'system-error thunk
157 (throw 'unresolved))))
158 (throw 'unresolved)))
160 (define (under-french-locale-or-unresolved thunk)
161 (under-locale-or-unresolved %french-locale thunk))
163 (define (under-french-utf8-locale-or-unresolved thunk)
164 (under-locale-or-unresolved %french-utf8-locale thunk))
166 (define (under-turkish-utf8-locale-or-unresolved thunk)
167 ;; FreeBSD 8.2 and 9.1, Solaris 2.10, Darwin 8.11.0, and MinGW have
168 ;; a broken tr_TR locale where `i' is mapped to uppercase `I'
169 ;; instead of `İ', so disable tests on that platform.
170 (if (or (string-contains %host-type "freebsd8")
171 (string-contains %host-type "freebsd9")
172 (string-contains %host-type "solaris2.10")
173 (string-contains %host-type "darwin8")
174 (string-contains %host-type "mingw32"))
176 (under-locale-or-unresolved %turkish-utf8-locale thunk)))
178 (define (under-german-utf8-locale-or-unresolved thunk)
179 (under-locale-or-unresolved %german-utf8-locale thunk))
181 (define (under-greek-utf8-locale-or-unresolved thunk)
182 (under-locale-or-unresolved %greek-utf8-locale thunk))
184 (define (under-american-english-locale-or-unresolved thunk)
185 (under-locale-or-unresolved %american-english-locale thunk))
188 (with-test-prefix "text collation (French)"
190 (pass-if "string-locale<?"
191 (under-french-locale-or-unresolved
193 (string-locale<? "été" "hiver" %french-locale))))
195 (pass-if "char-locale<?"
196 (under-french-locale-or-unresolved
198 (char-locale<? #\é #\h %french-locale))))
200 (pass-if "string-locale-ci=?"
201 (under-french-locale-or-unresolved
203 (string-locale-ci=? "ÉTÉ" "été" %french-locale))))
205 (pass-if "string-locale-ci=? (2 args, wide strings)"
206 (under-french-utf8-locale-or-unresolved
208 ;; Note: Character `œ' is not part of Latin-1, so these are wide
212 (setlocale LC_ALL %french-utf8-locale-name))
214 (string-locale-ci=? "œuf" "ŒUF"))
216 (setlocale LC_ALL "C"))))))
218 (pass-if "string-locale-ci=? (3 args, wide strings)"
219 (under-french-utf8-locale-or-unresolved
221 (string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale))))
223 (pass-if "string-locale-ci<>?"
224 (under-french-locale-or-unresolved
226 (and (string-locale-ci<? "été" "Hiver" %french-locale)
227 (string-locale-ci>? "HiVeR" "été" %french-locale)))))
229 (pass-if "string-locale-ci<>? (wide strings)"
230 (under-french-utf8-locale-or-unresolved
232 ;; One of the strings is UCS-4, the other is Latin-1.
233 (and (string-locale-ci<? "Œdème" "œuf" %french-utf8-locale)
234 (string-locale-ci>? "Œuf" "œdÈMe" %french-utf8-locale)))))
236 (pass-if "string-locale-ci<>? (wide and narrow strings)"
237 (under-french-utf8-locale-or-unresolved
239 ;; One of the strings is UCS-4, the other is Latin-1.
240 (and (string-locale-ci>? "Œdème" "odyssée" %french-utf8-locale)
241 (string-locale-ci<? "Odyssée" "œdème" %french-utf8-locale)))))
243 (pass-if "char-locale-ci<>?"
244 (under-french-locale-or-unresolved
246 (and (char-locale-ci<? #\é #\H %french-locale)
247 (char-locale-ci>? #\h #\É %french-locale)))))
249 (pass-if "char-locale-ci<>? (wide)"
250 (under-french-utf8-locale-or-unresolved
252 (and (char-locale-ci<? #\o #\œ %french-utf8-locale)
253 (char-locale-ci>? #\Œ #\e %french-utf8-locale))))))
256 (with-test-prefix "text collation (German)"
258 (pass-if "string-locale-ci=?"
259 (under-german-utf8-locale-or-unresolved
261 (let ((de (make-locale LC_ALL %german-utf8-locale-name)))
262 (string-locale-ci=? "Straße" "STRASSE"))))))
265 (with-test-prefix "text collation (Greek)"
267 (pass-if "string-locale-ci=?"
268 (under-greek-utf8-locale-or-unresolved
270 (let ((gr (make-locale LC_ALL %greek-utf8-locale-name)))
271 (string-locale-ci=? "ΧΑΟΣ" "χαος" gr))))))
274 (with-test-prefix "character mapping"
276 (pass-if "char-locale-downcase"
277 (and (eqv? #\a (char-locale-downcase #\A))
278 (eqv? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
280 (pass-if "char-locale-upcase"
281 (and (eqv? #\Z (char-locale-upcase #\z))
282 (eqv? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
284 (pass-if "char-locale-titlecase"
285 (and (eqv? #\T (char-locale-titlecase #\t))
286 (eqv? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
288 (pass-if "char-locale-titlecase Dž"
289 (and (eqv? #\762 (char-locale-titlecase #\763))
290 (eqv? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
292 (pass-if "char-locale-upcase Turkish"
293 (under-turkish-utf8-locale-or-unresolved
295 (eqv? #\İ (char-locale-upcase #\i %turkish-utf8-locale)))))
297 (pass-if "char-locale-downcase Turkish"
298 (under-turkish-utf8-locale-or-unresolved
300 (eqv? #\i (char-locale-downcase #\İ %turkish-utf8-locale))))))
303 (with-test-prefix "string mapping"
305 (pass-if "string-locale-downcase"
306 (and (string=? "a" (string-locale-downcase "A"))
307 (string=? "a" (string-locale-downcase "A" (make-locale LC_ALL "C")))))
309 (pass-if "string-locale-upcase"
310 (and (string=? "Z" (string-locale-upcase "z"))
311 (string=? "Z" (string-locale-upcase "z" (make-locale LC_ALL "C")))))
313 (pass-if "string-locale-titlecase"
314 (and (string=? "Hello, World" (string-locale-titlecase "hello, world"))
315 (string=? "Hello, World" (string-locale-titlecase
316 "hello, world" (make-locale LC_ALL "C")))))
318 (pass-if "string-locale-upcase German"
319 (under-german-utf8-locale-or-unresolved
321 (let ((de (make-locale LC_ALL %german-utf8-locale-name)))
323 (string-locale-upcase "Straße" de))))))
325 (pass-if "string-locale-upcase Greek"
326 (under-greek-utf8-locale-or-unresolved
328 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
330 (string-locale-upcase "χαος" el))))))
332 (pass-if "string-locale-upcase Greek (two sigmas)"
333 (under-greek-utf8-locale-or-unresolved
335 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
337 (string-locale-upcase "Γειά σας" el))))))
339 (pass-if "string-locale-downcase Greek"
340 (under-greek-utf8-locale-or-unresolved
342 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
344 (string-locale-downcase "ΧΑΟΣ" el))))))
346 (pass-if "string-locale-downcase Greek (two sigmas)"
347 (under-greek-utf8-locale-or-unresolved
349 (let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
351 (string-locale-downcase "ΓΕΙΆ ΣΑΣ" el))))))
353 (pass-if "string-locale-upcase Turkish"
354 (under-turkish-utf8-locale-or-unresolved
356 (string=? "İI" (string-locale-upcase "iı" %turkish-utf8-locale)))))
358 (pass-if "string-locale-downcase Turkish"
359 (under-turkish-utf8-locale-or-unresolved
361 (string=? "iı" (string-locale-downcase "İI" %turkish-utf8-locale))))))
364 (with-test-prefix "number parsing"
366 (pass-if "locale-string->integer"
367 (call-with-values (lambda () (locale-string->integer "123"))
368 (lambda (result char-count)
369 (and (equal? result 123)
370 (equal? char-count 3)))))
372 (pass-if "locale-string->inexact"
375 (locale-string->inexact "123.456"
376 (make-locale (list LC_NUMERIC) "C")))
377 (lambda (result char-count)
378 (and (equal? result 123.456)
379 (equal? char-count 7)))))
381 (pass-if "locale-string->inexact (French)"
382 (under-french-locale-or-unresolved
386 (locale-string->inexact "123,456" %french-locale))
387 (lambda (result char-count)
388 (and (equal? result 123.456)
389 (equal? char-count 7))))))))
396 (setlocale LC_ALL "C")
397 (define %c-locale (make-locale LC_ALL "C"))
399 (define %english-days
400 '("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
402 (define (every? . args)
403 (not (not (apply every args))))
406 (with-test-prefix "nl-langinfo et al."
408 (pass-if "locale-day (1 arg)"
411 (map locale-day (map 1+ (iota 7)))))
413 (pass-if "locale-day (2 args)"
417 (locale-day day %c-locale))
420 (pass-if "locale-day (2 args, using `%global-locale')"
424 (locale-day day %global-locale))
427 (pass-if "locale-day (French)"
428 (under-french-locale-or-unresolved
430 (let ((result (locale-day 3 %french-locale)))
431 (and (string? result)
432 (string-ci=? result "mardi"))))))
434 (pass-if "locale-day (French, using `%global-locale')"
435 ;; Make sure `%global-locale' captures the current locale settings as
436 ;; installed using `setlocale'.
437 (under-french-locale-or-unresolved
441 (setlocale LC_TIME %french-locale-name))
443 (let* ((fr (make-locale (list LC_MONETARY) "C" %global-locale))
444 (result (locale-day 3 fr)))
445 (setlocale LC_ALL "C")
446 (and (string? result)
447 (string-ci=? result "mardi"))))
449 (setlocale LC_ALL "C"))))))
451 (pass-if "default locale"
452 ;; Make sure the default locale does not capture the current locale
453 ;; settings as installed using `setlocale'. The default locale should be
455 (under-french-locale-or-unresolved
459 (setlocale LC_ALL %french-locale-name))
461 (let* ((locale (make-locale (list LC_MONETARY) "C"))
462 (result (locale-day 3 locale)))
463 (setlocale LC_ALL "C")
464 (and (string? result)
465 (string-ci=? result "Tuesday"))))
467 (setlocale LC_ALL "C")))))))
474 (with-test-prefix "number->locale-string"
476 ;; We assume the global locale is "C" at this point.
478 (with-test-prefix "C"
480 (pass-if "no thousand separator"
481 ;; Unlike in English, the "C" locale has no thousand separator.
482 ;; If this doesn't hold, the following tests will fail.
483 (string=? "" (locale-thousands-separator)))
486 (string=? "123456" (number->locale-string 123456)))
489 (string=? "1234.567" (number->locale-string 1234.567)))
491 (pass-if "fraction, 1 digit"
492 (string=? "1234.5" (number->locale-string 1234.567 1))))
494 (with-test-prefix "French"
497 (under-french-locale-or-unresolved
499 (let ((fr (make-locale LC_ALL %french-locale-name)))
500 (string=? "123 456" (number->locale-string 123456 #t fr))))))
503 (under-french-locale-or-unresolved
505 (let ((fr (make-locale LC_ALL %french-locale-name)))
506 (string=? "1 234,567" (number->locale-string 1234.567 #t fr))))))
508 (pass-if "fraction, 1 digit"
509 (under-french-locale-or-unresolved
511 (let ((fr (make-locale LC_ALL %french-locale-name)))
513 (number->locale-string 1234.567 1 fr))))))))
515 (with-test-prefix "format ~h"
517 ;; Some systems like Darwin lack the `GROUPING' nl_item, and thus
518 ;; `locale-digit-grouping' defaults to '(); skip the tests in that
521 (with-test-prefix "French"
523 (pass-if "12345.5678"
524 (under-french-locale-or-unresolved
526 (if (null? (locale-digit-grouping %french-locale))
528 (string=? "12 345,6789"
529 (format #f "~:h" 12345.6789 %french-locale)))))))
531 (with-test-prefix "English"
533 (pass-if "12345.5678"
534 (under-american-english-locale-or-unresolved
536 (if (null? (locale-digit-grouping %american-english-locale))
538 (string=? "12,345.6789"
539 (format #f "~:h" 12345.6789
540 %american-english-locale))))))))
542 (with-test-prefix "monetary-amount->locale-string"
544 (with-test-prefix "French"
547 (under-french-locale-or-unresolved
549 (let ((fr (make-locale LC_ALL %french-locale-name)))
550 (string=? "123 456 +EUR"
551 (monetary-amount->locale-string 123456 #f fr))))))
554 (under-french-locale-or-unresolved
556 (let ((fr (make-locale LC_ALL %french-locale-name)))
557 (string=? "1 234,56 EUR "
558 (monetary-amount->locale-string 1234.567 #t fr))))))))