Commit | Line | Data |
---|---|---|
cdf52ff0 | 1 | ;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*- |
5b3a39c7 | 2 | ;;;; |
9ea816f5 | 3 | ;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011, 2012, |
c84f25bc | 4 | ;;;; 2013, 2014 Free Software Foundation, Inc. |
cdf52ff0 | 5 | ;;;; Ludovic Courtès |
5b3a39c7 LC |
6 | ;;;; |
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 | |
53befeb7 NJ |
10 | ;;;; version 3 of the License, or (at your option) any later version. |
11 | ;;;; | |
5b3a39c7 LC |
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. | |
53befeb7 | 16 | ;;;; |
5b3a39c7 LC |
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 | |
20 | ||
21 | (define-module (test-suite i18n) | |
afd08fdf LC |
22 | #:use-module (ice-9 i18n) |
23 | #:use-module (ice-9 format) | |
24 | #:use-module (srfi srfi-1) | |
25 | #:use-module (test-suite lib)) | |
5b3a39c7 LC |
26 | |
27 | ;; Start from a pristine locale state. | |
28 | (setlocale LC_ALL "C") | |
29 | ||
a2f00b9b LC |
30 | (define exception:locale-error |
31 | (cons 'system-error "Failed to install locale")) | |
32 | ||
33 | ||
5b3a39c7 LC |
34 | \f |
35 | (with-test-prefix "locale objects" | |
36 | ||
37 | (pass-if "make-locale (2 args)" | |
a2f00b9b LC |
38 | (not (not (make-locale LC_ALL "C")))) |
39 | ||
40 | (pass-if "make-locale (2 args, list)" | |
c84f25bc | 41 | (not (not (make-locale (list LC_COLLATE LC_NUMERIC) "C")))) |
5b3a39c7 LC |
42 | |
43 | (pass-if "make-locale (3 args)" | |
a2f00b9b | 44 | (not (not (make-locale (list LC_COLLATE) "C" |
c84f25bc | 45 | (make-locale (list LC_NUMERIC) "C"))))) |
a2f00b9b LC |
46 | |
47 | (pass-if-exception "make-locale with unknown locale" exception:locale-error | |
48 | (make-locale LC_ALL "does-not-exist")) | |
5b3a39c7 LC |
49 | |
50 | (pass-if "locale?" | |
a2f00b9b | 51 | (and (locale? (make-locale (list LC_ALL) "C")) |
c84f25bc | 52 | (locale? (make-locale (list LC_TIME LC_NUMERIC) "C" |
a2f00b9b LC |
53 | (make-locale (list LC_CTYPE) "C"))))) |
54 | ||
55 | (pass-if "%global-locale" | |
56 | (and (locale? %global-locale)) | |
57 | (locale? (make-locale (list LC_MONETARY) "C" | |
58 | %global-locale)))) | |
5b3a39c7 LC |
59 | |
60 | ||
61 | \f | |
62 | (with-test-prefix "text collation (English)" | |
63 | ||
64 | (pass-if "string-locale<?" | |
65 | (and (string-locale<? "hello" "world") | |
66 | (string-locale<? "hello" "world" | |
a2f00b9b | 67 | (make-locale (list LC_COLLATE) "C")))) |
5b3a39c7 LC |
68 | |
69 | (pass-if "char-locale<?" | |
70 | (and (char-locale<? #\a #\b) | |
a2f00b9b | 71 | (char-locale<? #\a #\b (make-locale (list LC_COLLATE) "C")))) |
5b3a39c7 LC |
72 | |
73 | (pass-if "string-locale-ci=?" | |
74 | (and (string-locale-ci=? "Hello" "HELLO") | |
75 | (string-locale-ci=? "Hello" "HELLO" | |
a2f00b9b | 76 | (make-locale (list LC_COLLATE) "C")))) |
5b3a39c7 LC |
77 | |
78 | (pass-if "string-locale-ci<?" | |
79 | (and (string-locale-ci<? "hello" "WORLD") | |
80 | (string-locale-ci<? "hello" "WORLD" | |
a2f00b9b | 81 | (make-locale (list LC_COLLATE) "C"))))) |
5b3a39c7 LC |
82 | |
83 | \f | |
700f6cd8 LC |
84 | (define mingw? |
85 | (string-contains %host-type "-mingw32")) | |
86 | ||
a2f00b9b | 87 | (define %french-locale-name |
700f6cd8 LC |
88 | (if mingw? |
89 | "fra_FRA.850" | |
90 | "fr_FR.ISO-8859-1")) | |
91 | ||
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. | |
a2f00b9b | 94 | |
cdf52ff0 | 95 | (define %french-utf8-locale-name |
700f6cd8 LC |
96 | (if mingw? |
97 | "fra_FRA.1252" | |
98 | "fr_FR.UTF-8")) | |
cdf52ff0 | 99 | |
bcccf041 | 100 | (define %turkish-utf8-locale-name |
700f6cd8 LC |
101 | (if mingw? |
102 | "tur_TRK.1254" | |
103 | "tr_TR.UTF-8")) | |
bcccf041 | 104 | |
e4612ff6 | 105 | (define %german-utf8-locale-name |
700f6cd8 LC |
106 | (if mingw? |
107 | "deu_DEU.1252" | |
108 | "de_DE.UTF-8")) | |
e4612ff6 LC |
109 | |
110 | (define %greek-utf8-locale-name | |
700f6cd8 LC |
111 | (if mingw? |
112 | "grc_ELL.1253" | |
113 | "el_GR.UTF-8")) | |
e4612ff6 | 114 | |
afd08fdf LC |
115 | (define %american-english-locale-name |
116 | "en_US") | |
117 | ||
5b3a39c7 LC |
118 | (define %french-locale |
119 | (false-if-exception | |
a2f00b9b LC |
120 | (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) |
121 | %french-locale-name))) | |
5b3a39c7 | 122 | |
cdf52ff0 LC |
123 | (define %french-utf8-locale |
124 | (false-if-exception | |
125 | (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) | |
126 | %french-utf8-locale-name))) | |
127 | ||
60582b7c LC |
128 | (define %german-utf8-locale |
129 | (false-if-exception | |
130 | (make-locale LC_ALL | |
131 | %german-utf8-locale-name))) | |
132 | ||
133 | (define %greek-utf8-locale | |
134 | (false-if-exception | |
135 | (make-locale LC_ALL | |
136 | %greek-utf8-locale-name))) | |
137 | ||
bcccf041 MG |
138 | (define %turkish-utf8-locale |
139 | (false-if-exception | |
140 | (make-locale LC_ALL | |
141 | %turkish-utf8-locale-name))) | |
142 | ||
afd08fdf LC |
143 | (define %american-english-locale |
144 | (false-if-exception | |
145 | (make-locale LC_ALL | |
146 | %american-english-locale-name))) | |
147 | ||
cdf52ff0 | 148 | (define (under-locale-or-unresolved locale thunk) |
5b3a39c7 LC |
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 | |
151 | ;; against both. | |
cdf52ff0 LC |
152 | (if locale |
153 | (if (string-contains %host-type "-gnu") | |
154 | (thunk) | |
155 | (catch 'system-error thunk | |
156 | (lambda (key . args) | |
157 | (throw 'unresolved)))) | |
5b3a39c7 LC |
158 | (throw 'unresolved))) |
159 | ||
cdf52ff0 LC |
160 | (define (under-french-locale-or-unresolved thunk) |
161 | (under-locale-or-unresolved %french-locale thunk)) | |
162 | ||
163 | (define (under-french-utf8-locale-or-unresolved thunk) | |
164 | (under-locale-or-unresolved %french-utf8-locale thunk)) | |
165 | ||
bcccf041 | 166 | (define (under-turkish-utf8-locale-or-unresolved thunk) |
700f6cd8 LC |
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. | |
d143fac6 | 170 | (if (or (string-contains %host-type "freebsd8") |
9ea816f5 | 171 | (string-contains %host-type "freebsd9") |
6f63f118 | 172 | (string-contains %host-type "solaris2.10") |
700f6cd8 LC |
173 | (string-contains %host-type "darwin8") |
174 | (string-contains %host-type "mingw32")) | |
17cdda21 LC |
175 | (throw 'unresolved) |
176 | (under-locale-or-unresolved %turkish-utf8-locale thunk))) | |
cdf52ff0 | 177 | |
e4612ff6 | 178 | (define (under-german-utf8-locale-or-unresolved thunk) |
60582b7c | 179 | (under-locale-or-unresolved %german-utf8-locale thunk)) |
e4612ff6 LC |
180 | |
181 | (define (under-greek-utf8-locale-or-unresolved thunk) | |
60582b7c | 182 | (under-locale-or-unresolved %greek-utf8-locale thunk)) |
e4612ff6 | 183 | |
afd08fdf LC |
184 | (define (under-american-english-locale-or-unresolved thunk) |
185 | (under-locale-or-unresolved %american-english-locale thunk)) | |
186 | ||
187 | ||
5b3a39c7 LC |
188 | (with-test-prefix "text collation (French)" |
189 | ||
190 | (pass-if "string-locale<?" | |
191 | (under-french-locale-or-unresolved | |
192 | (lambda () | |
cdf52ff0 | 193 | (string-locale<? "été" "hiver" %french-locale)))) |
5b3a39c7 LC |
194 | |
195 | (pass-if "char-locale<?" | |
196 | (under-french-locale-or-unresolved | |
197 | (lambda () | |
cdf52ff0 | 198 | (char-locale<? #\é #\h %french-locale)))) |
5b3a39c7 LC |
199 | |
200 | (pass-if "string-locale-ci=?" | |
201 | (under-french-locale-or-unresolved | |
202 | (lambda () | |
cdf52ff0 LC |
203 | (string-locale-ci=? "ÉTÉ" "été" %french-locale)))) |
204 | ||
205 | (pass-if "string-locale-ci=? (2 args, wide strings)" | |
206 | (under-french-utf8-locale-or-unresolved | |
207 | (lambda () | |
208 | ;; Note: Character `œ' is not part of Latin-1, so these are wide | |
209 | ;; strings. | |
210 | (dynamic-wind | |
211 | (lambda () | |
700f6cd8 | 212 | (setlocale LC_ALL %french-utf8-locale-name)) |
cdf52ff0 LC |
213 | (lambda () |
214 | (string-locale-ci=? "œuf" "ŒUF")) | |
215 | (lambda () | |
216 | (setlocale LC_ALL "C")))))) | |
217 | ||
218 | (pass-if "string-locale-ci=? (3 args, wide strings)" | |
219 | (under-french-utf8-locale-or-unresolved | |
220 | (lambda () | |
221 | (string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale)))) | |
5b3a39c7 LC |
222 | |
223 | (pass-if "string-locale-ci<>?" | |
224 | (under-french-locale-or-unresolved | |
225 | (lambda () | |
cdf52ff0 LC |
226 | (and (string-locale-ci<? "été" "Hiver" %french-locale) |
227 | (string-locale-ci>? "HiVeR" "été" %french-locale))))) | |
228 | ||
229 | (pass-if "string-locale-ci<>? (wide strings)" | |
230 | (under-french-utf8-locale-or-unresolved | |
231 | (lambda () | |
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))))) | |
235 | ||
236 | (pass-if "string-locale-ci<>? (wide and narrow strings)" | |
237 | (under-french-utf8-locale-or-unresolved | |
238 | (lambda () | |
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))))) | |
5b3a39c7 LC |
242 | |
243 | (pass-if "char-locale-ci<>?" | |
244 | (under-french-locale-or-unresolved | |
245 | (lambda () | |
cdf52ff0 LC |
246 | (and (char-locale-ci<? #\é #\H %french-locale) |
247 | (char-locale-ci>? #\h #\É %french-locale))))) | |
248 | ||
249 | (pass-if "char-locale-ci<>? (wide)" | |
250 | (under-french-utf8-locale-or-unresolved | |
251 | (lambda () | |
252 | (and (char-locale-ci<? #\o #\œ %french-utf8-locale) | |
253 | (char-locale-ci>? #\Œ #\e %french-utf8-locale)))))) | |
5b3a39c7 LC |
254 | |
255 | \f | |
e4612ff6 LC |
256 | (with-test-prefix "text collation (German)" |
257 | ||
258 | (pass-if "string-locale-ci=?" | |
259 | (under-german-utf8-locale-or-unresolved | |
260 | (lambda () | |
261 | (let ((de (make-locale LC_ALL %german-utf8-locale-name))) | |
262 | (string-locale-ci=? "Straße" "STRASSE")))))) | |
263 | ||
264 | \f | |
265 | (with-test-prefix "text collation (Greek)" | |
266 | ||
267 | (pass-if "string-locale-ci=?" | |
268 | (under-greek-utf8-locale-or-unresolved | |
269 | (lambda () | |
270 | (let ((gr (make-locale LC_ALL %greek-utf8-locale-name))) | |
271 | (string-locale-ci=? "ΧΑΟΣ" "χαος" gr)))))) | |
272 | ||
273 | \f | |
5b3a39c7 LC |
274 | (with-test-prefix "character mapping" |
275 | ||
276 | (pass-if "char-locale-downcase" | |
764246cf DH |
277 | (and (eqv? #\a (char-locale-downcase #\A)) |
278 | (eqv? #\a (char-locale-downcase #\A (make-locale LC_ALL "C"))))) | |
5b3a39c7 LC |
279 | |
280 | (pass-if "char-locale-upcase" | |
764246cf DH |
281 | (and (eqv? #\Z (char-locale-upcase #\z)) |
282 | (eqv? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C"))))) | |
bcccf041 | 283 | |
820f33aa | 284 | (pass-if "char-locale-titlecase" |
764246cf DH |
285 | (and (eqv? #\T (char-locale-titlecase #\t)) |
286 | (eqv? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C"))))) | |
820f33aa JG |
287 | |
288 | (pass-if "char-locale-titlecase Dž" | |
764246cf DH |
289 | (and (eqv? #\762 (char-locale-titlecase #\763)) |
290 | (eqv? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C"))))) | |
820f33aa | 291 | |
bcccf041 MG |
292 | (pass-if "char-locale-upcase Turkish" |
293 | (under-turkish-utf8-locale-or-unresolved | |
294 | (lambda () | |
764246cf | 295 | (eqv? #\İ (char-locale-upcase #\i %turkish-utf8-locale))))) |
bcccf041 MG |
296 | |
297 | (pass-if "char-locale-downcase Turkish" | |
298 | (under-turkish-utf8-locale-or-unresolved | |
299 | (lambda () | |
764246cf | 300 | (eqv? #\i (char-locale-downcase #\İ %turkish-utf8-locale)))))) |
bcccf041 MG |
301 | |
302 | \f | |
303 | (with-test-prefix "string mapping" | |
304 | ||
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"))))) | |
308 | ||
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"))))) | |
312 | ||
820f33aa JG |
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"))))) | |
317 | ||
e4612ff6 LC |
318 | (pass-if "string-locale-upcase German" |
319 | (under-german-utf8-locale-or-unresolved | |
320 | (lambda () | |
321 | (let ((de (make-locale LC_ALL %german-utf8-locale-name))) | |
322 | (string=? "STRASSE" | |
323 | (string-locale-upcase "Straße" de)))))) | |
324 | ||
325 | (pass-if "string-locale-upcase Greek" | |
326 | (under-greek-utf8-locale-or-unresolved | |
327 | (lambda () | |
328 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
329 | (string=? "ΧΑΟΣ" | |
330 | (string-locale-upcase "χαος" el)))))) | |
331 | ||
332 | (pass-if "string-locale-upcase Greek (two sigmas)" | |
333 | (under-greek-utf8-locale-or-unresolved | |
334 | (lambda () | |
335 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
336 | (string=? "ΓΕΙΆ ΣΑΣ" | |
337 | (string-locale-upcase "Γειά σας" el)))))) | |
338 | ||
339 | (pass-if "string-locale-downcase Greek" | |
340 | (under-greek-utf8-locale-or-unresolved | |
341 | (lambda () | |
342 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
343 | (string=? "χαος" | |
344 | (string-locale-downcase "ΧΑΟΣ" el)))))) | |
345 | ||
346 | (pass-if "string-locale-downcase Greek (two sigmas)" | |
347 | (under-greek-utf8-locale-or-unresolved | |
348 | (lambda () | |
349 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
350 | (string=? "γειά σας" | |
351 | (string-locale-downcase "ΓΕΙΆ ΣΑΣ" el)))))) | |
352 | ||
bcccf041 MG |
353 | (pass-if "string-locale-upcase Turkish" |
354 | (under-turkish-utf8-locale-or-unresolved | |
355 | (lambda () | |
356 | (string=? "İI" (string-locale-upcase "iı" %turkish-utf8-locale))))) | |
357 | ||
358 | (pass-if "string-locale-downcase Turkish" | |
359 | (under-turkish-utf8-locale-or-unresolved | |
360 | (lambda () | |
361 | (string=? "iı" (string-locale-downcase "İI" %turkish-utf8-locale)))))) | |
5b3a39c7 LC |
362 | |
363 | \f | |
364 | (with-test-prefix "number parsing" | |
365 | ||
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))))) | |
371 | ||
372 | (pass-if "locale-string->inexact" | |
373 | (call-with-values | |
374 | (lambda () | |
375 | (locale-string->inexact "123.456" | |
a2f00b9b | 376 | (make-locale (list LC_NUMERIC) "C"))) |
5b3a39c7 LC |
377 | (lambda (result char-count) |
378 | (and (equal? result 123.456) | |
a2f00b9b LC |
379 | (equal? char-count 7))))) |
380 | ||
381 | (pass-if "locale-string->inexact (French)" | |
382 | (under-french-locale-or-unresolved | |
383 | (lambda () | |
384 | (call-with-values | |
385 | (lambda () | |
386 | (locale-string->inexact "123,456" %french-locale)) | |
387 | (lambda (result char-count) | |
388 | (and (equal? result 123.456) | |
389 | (equal? char-count 7)))))))) | |
390 | ||
391 | \f | |
392 | ;;; | |
393 | ;;; `nl-langinfo' | |
394 | ;;; | |
395 | ||
396 | (setlocale LC_ALL "C") | |
397 | (define %c-locale (make-locale LC_ALL "C")) | |
398 | ||
399 | (define %english-days | |
400 | '("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")) | |
401 | ||
402 | (define (every? . args) | |
403 | (not (not (apply every args)))) | |
404 | ||
405 | ||
406 | (with-test-prefix "nl-langinfo et al." | |
407 | ||
408 | (pass-if "locale-day (1 arg)" | |
409 | (every? equal? | |
410 | %english-days | |
411 | (map locale-day (map 1+ (iota 7))))) | |
412 | ||
413 | (pass-if "locale-day (2 args)" | |
414 | (every? equal? | |
415 | %english-days | |
416 | (map (lambda (day) | |
417 | (locale-day day %c-locale)) | |
418 | (map 1+ (iota 7))))) | |
419 | ||
420 | (pass-if "locale-day (2 args, using `%global-locale')" | |
421 | (every? equal? | |
422 | %english-days | |
423 | (map (lambda (day) | |
424 | (locale-day day %global-locale)) | |
425 | (map 1+ (iota 7))))) | |
426 | ||
427 | (pass-if "locale-day (French)" | |
428 | (under-french-locale-or-unresolved | |
429 | (lambda () | |
430 | (let ((result (locale-day 3 %french-locale))) | |
431 | (and (string? result) | |
432 | (string-ci=? result "mardi")))))) | |
433 | ||
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 | |
438 | (lambda () | |
439 | (dynamic-wind | |
440 | (lambda () | |
441 | (setlocale LC_TIME %french-locale-name)) | |
442 | (lambda () | |
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")))) | |
448 | (lambda () | |
449 | (setlocale LC_ALL "C")))))) | |
450 | ||
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 | |
454 | ;; "C". | |
455 | (under-french-locale-or-unresolved | |
456 | (lambda () | |
457 | (dynamic-wind | |
458 | (lambda () | |
459 | (setlocale LC_ALL %french-locale-name)) | |
460 | (lambda () | |
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")))) | |
466 | (lambda () | |
467 | (setlocale LC_ALL "C"))))))) | |
61d1d4a8 LC |
468 | |
469 | \f | |
470 | ;;; | |
471 | ;;; Numbers. | |
472 | ;;; | |
473 | ||
474 | (with-test-prefix "number->locale-string" | |
475 | ||
476 | ;; We assume the global locale is "C" at this point. | |
477 | ||
478 | (with-test-prefix "C" | |
479 | ||
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))) | |
484 | ||
485 | (pass-if "integer" | |
486 | (string=? "123456" (number->locale-string 123456))) | |
487 | ||
488 | (pass-if "fraction" | |
489 | (string=? "1234.567" (number->locale-string 1234.567))) | |
490 | ||
491 | (pass-if "fraction, 1 digit" | |
492 | (string=? "1234.5" (number->locale-string 1234.567 1)))) | |
493 | ||
494 | (with-test-prefix "French" | |
495 | ||
252f9f18 LC |
496 | (pass-if "integer" |
497 | (under-french-locale-or-unresolved | |
498 | (lambda () | |
499 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
500 | (string=? "123 456" (number->locale-string 123456 #t fr)))))) | |
61d1d4a8 | 501 | |
252f9f18 LC |
502 | (pass-if "fraction" |
503 | (under-french-locale-or-unresolved | |
504 | (lambda () | |
505 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
506 | (string=? "1 234,567" (number->locale-string 1234.567 #t fr)))))) | |
61d1d4a8 | 507 | |
252f9f18 LC |
508 | (pass-if "fraction, 1 digit" |
509 | (under-french-locale-or-unresolved | |
510 | (lambda () | |
511 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
512 | (string=? "1 234,5" | |
513 | (number->locale-string 1234.567 1 fr)))))))) | |
c76fdf69 | 514 | |
afd08fdf LC |
515 | (with-test-prefix "format ~h" |
516 | ||
13fb25ba LC |
517 | ;; Some systems like Darwin lack the `GROUPING' nl_item, and thus |
518 | ;; `locale-digit-grouping' defaults to '(); skip the tests in that | |
519 | ;; case. | |
520 | ||
afd08fdf LC |
521 | (with-test-prefix "French" |
522 | ||
523 | (pass-if "12345.5678" | |
524 | (under-french-locale-or-unresolved | |
525 | (lambda () | |
13fb25ba LC |
526 | (if (null? (locale-digit-grouping %french-locale)) |
527 | (throw 'unresolved) | |
528 | (string=? "12 345,6789" | |
529 | (format #f "~:h" 12345.6789 %french-locale))))))) | |
afd08fdf LC |
530 | |
531 | (with-test-prefix "English" | |
532 | ||
533 | (pass-if "12345.5678" | |
534 | (under-american-english-locale-or-unresolved | |
535 | (lambda () | |
13fb25ba LC |
536 | (if (null? (locale-digit-grouping %american-english-locale)) |
537 | (throw 'unresolved) | |
538 | (string=? "12,345.6789" | |
539 | (format #f "~:h" 12345.6789 | |
540 | %american-english-locale)))))))) | |
afd08fdf | 541 | |
c76fdf69 LC |
542 | (with-test-prefix "monetary-amount->locale-string" |
543 | ||
544 | (with-test-prefix "French" | |
545 | ||
546 | (pass-if "integer" | |
547 | (under-french-locale-or-unresolved | |
548 | (lambda () | |
549 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
550 | (string=? "123 456 +EUR" | |
551 | (monetary-amount->locale-string 123456 #f fr)))))) | |
552 | ||
553 | (pass-if "fraction" | |
554 | (under-french-locale-or-unresolved | |
555 | (lambda () | |
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)))))))) |