Commit | Line | Data |
---|---|---|
cdf52ff0 | 1 | ;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*- |
5b3a39c7 | 2 | ;;;; |
9ea816f5 MW |
3 | ;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011, 2012, |
4 | ;;;; 2013 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)" | |
41 | (not (not (make-locale (list LC_COLLATE LC_MESSAGES) "C")))) | |
5b3a39c7 LC |
42 | |
43 | (pass-if "make-locale (3 args)" | |
a2f00b9b LC |
44 | (not (not (make-locale (list LC_COLLATE) "C" |
45 | (make-locale (list LC_MESSAGES) "C"))))) | |
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 LC |
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"))))) | |
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 | |
a2f00b9b LC |
84 | (define %french-locale-name |
85 | "fr_FR.ISO-8859-1") | |
86 | ||
cdf52ff0 LC |
87 | (define %french-utf8-locale-name |
88 | "fr_FR.UTF-8") | |
89 | ||
bcccf041 MG |
90 | (define %turkish-utf8-locale-name |
91 | "tr_TR.UTF-8") | |
92 | ||
e4612ff6 LC |
93 | (define %german-utf8-locale-name |
94 | "de_DE.UTF-8") | |
95 | ||
96 | (define %greek-utf8-locale-name | |
97 | "el_GR.UTF-8") | |
98 | ||
afd08fdf LC |
99 | (define %american-english-locale-name |
100 | "en_US") | |
101 | ||
5b3a39c7 LC |
102 | (define %french-locale |
103 | (false-if-exception | |
a2f00b9b LC |
104 | (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) |
105 | %french-locale-name))) | |
5b3a39c7 | 106 | |
cdf52ff0 LC |
107 | (define %french-utf8-locale |
108 | (false-if-exception | |
109 | (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME) | |
110 | %french-utf8-locale-name))) | |
111 | ||
60582b7c LC |
112 | (define %german-utf8-locale |
113 | (false-if-exception | |
114 | (make-locale LC_ALL | |
115 | %german-utf8-locale-name))) | |
116 | ||
117 | (define %greek-utf8-locale | |
118 | (false-if-exception | |
119 | (make-locale LC_ALL | |
120 | %greek-utf8-locale-name))) | |
121 | ||
bcccf041 MG |
122 | (define %turkish-utf8-locale |
123 | (false-if-exception | |
124 | (make-locale LC_ALL | |
125 | %turkish-utf8-locale-name))) | |
126 | ||
afd08fdf LC |
127 | (define %american-english-locale |
128 | (false-if-exception | |
129 | (make-locale LC_ALL | |
130 | %american-english-locale-name))) | |
131 | ||
cdf52ff0 | 132 | (define (under-locale-or-unresolved locale thunk) |
5b3a39c7 LC |
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 | |
135 | ;; against both. | |
cdf52ff0 LC |
136 | (if locale |
137 | (if (string-contains %host-type "-gnu") | |
138 | (thunk) | |
139 | (catch 'system-error thunk | |
140 | (lambda (key . args) | |
141 | (throw 'unresolved)))) | |
5b3a39c7 LC |
142 | (throw 'unresolved))) |
143 | ||
cdf52ff0 LC |
144 | (define (under-french-locale-or-unresolved thunk) |
145 | (under-locale-or-unresolved %french-locale thunk)) | |
146 | ||
147 | (define (under-french-utf8-locale-or-unresolved thunk) | |
148 | (under-locale-or-unresolved %french-utf8-locale thunk)) | |
149 | ||
bcccf041 | 150 | (define (under-turkish-utf8-locale-or-unresolved thunk) |
9ea816f5 MW |
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. | |
d143fac6 | 154 | (if (or (string-contains %host-type "freebsd8") |
9ea816f5 | 155 | (string-contains %host-type "freebsd9") |
6f63f118 LC |
156 | (string-contains %host-type "solaris2.10") |
157 | (string-contains %host-type "darwin8")) | |
17cdda21 LC |
158 | (throw 'unresolved) |
159 | (under-locale-or-unresolved %turkish-utf8-locale thunk))) | |
cdf52ff0 | 160 | |
e4612ff6 | 161 | (define (under-german-utf8-locale-or-unresolved thunk) |
60582b7c | 162 | (under-locale-or-unresolved %german-utf8-locale thunk)) |
e4612ff6 LC |
163 | |
164 | (define (under-greek-utf8-locale-or-unresolved thunk) | |
60582b7c | 165 | (under-locale-or-unresolved %greek-utf8-locale thunk)) |
e4612ff6 | 166 | |
afd08fdf LC |
167 | (define (under-american-english-locale-or-unresolved thunk) |
168 | (under-locale-or-unresolved %american-english-locale thunk)) | |
169 | ||
170 | ||
5b3a39c7 LC |
171 | (with-test-prefix "text collation (French)" |
172 | ||
173 | (pass-if "string-locale<?" | |
174 | (under-french-locale-or-unresolved | |
175 | (lambda () | |
cdf52ff0 | 176 | (string-locale<? "été" "hiver" %french-locale)))) |
5b3a39c7 LC |
177 | |
178 | (pass-if "char-locale<?" | |
179 | (under-french-locale-or-unresolved | |
180 | (lambda () | |
cdf52ff0 | 181 | (char-locale<? #\é #\h %french-locale)))) |
5b3a39c7 LC |
182 | |
183 | (pass-if "string-locale-ci=?" | |
184 | (under-french-locale-or-unresolved | |
185 | (lambda () | |
cdf52ff0 LC |
186 | (string-locale-ci=? "ÉTÉ" "été" %french-locale)))) |
187 | ||
188 | (pass-if "string-locale-ci=? (2 args, wide strings)" | |
189 | (under-french-utf8-locale-or-unresolved | |
190 | (lambda () | |
191 | ;; Note: Character `œ' is not part of Latin-1, so these are wide | |
192 | ;; strings. | |
193 | (dynamic-wind | |
194 | (lambda () | |
195 | (setlocale LC_ALL "fr_FR.UTF-8")) | |
196 | (lambda () | |
197 | (string-locale-ci=? "œuf" "ŒUF")) | |
198 | (lambda () | |
199 | (setlocale LC_ALL "C")))))) | |
200 | ||
201 | (pass-if "string-locale-ci=? (3 args, wide strings)" | |
202 | (under-french-utf8-locale-or-unresolved | |
203 | (lambda () | |
204 | (string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale)))) | |
5b3a39c7 LC |
205 | |
206 | (pass-if "string-locale-ci<>?" | |
207 | (under-french-locale-or-unresolved | |
208 | (lambda () | |
cdf52ff0 LC |
209 | (and (string-locale-ci<? "été" "Hiver" %french-locale) |
210 | (string-locale-ci>? "HiVeR" "été" %french-locale))))) | |
211 | ||
212 | (pass-if "string-locale-ci<>? (wide strings)" | |
213 | (under-french-utf8-locale-or-unresolved | |
214 | (lambda () | |
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))))) | |
218 | ||
219 | (pass-if "string-locale-ci<>? (wide and narrow strings)" | |
220 | (under-french-utf8-locale-or-unresolved | |
221 | (lambda () | |
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))))) | |
5b3a39c7 LC |
225 | |
226 | (pass-if "char-locale-ci<>?" | |
227 | (under-french-locale-or-unresolved | |
228 | (lambda () | |
cdf52ff0 LC |
229 | (and (char-locale-ci<? #\é #\H %french-locale) |
230 | (char-locale-ci>? #\h #\É %french-locale))))) | |
231 | ||
232 | (pass-if "char-locale-ci<>? (wide)" | |
233 | (under-french-utf8-locale-or-unresolved | |
234 | (lambda () | |
235 | (and (char-locale-ci<? #\o #\œ %french-utf8-locale) | |
236 | (char-locale-ci>? #\Œ #\e %french-utf8-locale)))))) | |
5b3a39c7 LC |
237 | |
238 | \f | |
e4612ff6 LC |
239 | (with-test-prefix "text collation (German)" |
240 | ||
241 | (pass-if "string-locale-ci=?" | |
242 | (under-german-utf8-locale-or-unresolved | |
243 | (lambda () | |
244 | (let ((de (make-locale LC_ALL %german-utf8-locale-name))) | |
245 | (string-locale-ci=? "Straße" "STRASSE")))))) | |
246 | ||
247 | \f | |
248 | (with-test-prefix "text collation (Greek)" | |
249 | ||
250 | (pass-if "string-locale-ci=?" | |
251 | (under-greek-utf8-locale-or-unresolved | |
252 | (lambda () | |
253 | (let ((gr (make-locale LC_ALL %greek-utf8-locale-name))) | |
254 | (string-locale-ci=? "ΧΑΟΣ" "χαος" gr)))))) | |
255 | ||
256 | \f | |
5b3a39c7 LC |
257 | (with-test-prefix "character mapping" |
258 | ||
259 | (pass-if "char-locale-downcase" | |
764246cf DH |
260 | (and (eqv? #\a (char-locale-downcase #\A)) |
261 | (eqv? #\a (char-locale-downcase #\A (make-locale LC_ALL "C"))))) | |
5b3a39c7 LC |
262 | |
263 | (pass-if "char-locale-upcase" | |
764246cf DH |
264 | (and (eqv? #\Z (char-locale-upcase #\z)) |
265 | (eqv? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C"))))) | |
bcccf041 | 266 | |
820f33aa | 267 | (pass-if "char-locale-titlecase" |
764246cf DH |
268 | (and (eqv? #\T (char-locale-titlecase #\t)) |
269 | (eqv? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C"))))) | |
820f33aa JG |
270 | |
271 | (pass-if "char-locale-titlecase Dž" | |
764246cf DH |
272 | (and (eqv? #\762 (char-locale-titlecase #\763)) |
273 | (eqv? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C"))))) | |
820f33aa | 274 | |
bcccf041 MG |
275 | (pass-if "char-locale-upcase Turkish" |
276 | (under-turkish-utf8-locale-or-unresolved | |
277 | (lambda () | |
764246cf | 278 | (eqv? #\İ (char-locale-upcase #\i %turkish-utf8-locale))))) |
bcccf041 MG |
279 | |
280 | (pass-if "char-locale-downcase Turkish" | |
281 | (under-turkish-utf8-locale-or-unresolved | |
282 | (lambda () | |
764246cf | 283 | (eqv? #\i (char-locale-downcase #\İ %turkish-utf8-locale)))))) |
bcccf041 MG |
284 | |
285 | \f | |
286 | (with-test-prefix "string mapping" | |
287 | ||
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"))))) | |
291 | ||
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"))))) | |
295 | ||
820f33aa JG |
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"))))) | |
300 | ||
e4612ff6 LC |
301 | (pass-if "string-locale-upcase German" |
302 | (under-german-utf8-locale-or-unresolved | |
303 | (lambda () | |
304 | (let ((de (make-locale LC_ALL %german-utf8-locale-name))) | |
305 | (string=? "STRASSE" | |
306 | (string-locale-upcase "Straße" de)))))) | |
307 | ||
308 | (pass-if "string-locale-upcase Greek" | |
309 | (under-greek-utf8-locale-or-unresolved | |
310 | (lambda () | |
311 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
312 | (string=? "ΧΑΟΣ" | |
313 | (string-locale-upcase "χαος" el)))))) | |
314 | ||
315 | (pass-if "string-locale-upcase Greek (two sigmas)" | |
316 | (under-greek-utf8-locale-or-unresolved | |
317 | (lambda () | |
318 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
319 | (string=? "ΓΕΙΆ ΣΑΣ" | |
320 | (string-locale-upcase "Γειά σας" el)))))) | |
321 | ||
322 | (pass-if "string-locale-downcase Greek" | |
323 | (under-greek-utf8-locale-or-unresolved | |
324 | (lambda () | |
325 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
326 | (string=? "χαος" | |
327 | (string-locale-downcase "ΧΑΟΣ" el)))))) | |
328 | ||
329 | (pass-if "string-locale-downcase Greek (two sigmas)" | |
330 | (under-greek-utf8-locale-or-unresolved | |
331 | (lambda () | |
332 | (let ((el (make-locale LC_ALL %greek-utf8-locale-name))) | |
333 | (string=? "γειά σας" | |
334 | (string-locale-downcase "ΓΕΙΆ ΣΑΣ" el)))))) | |
335 | ||
bcccf041 MG |
336 | (pass-if "string-locale-upcase Turkish" |
337 | (under-turkish-utf8-locale-or-unresolved | |
338 | (lambda () | |
339 | (string=? "İI" (string-locale-upcase "iı" %turkish-utf8-locale))))) | |
340 | ||
341 | (pass-if "string-locale-downcase Turkish" | |
342 | (under-turkish-utf8-locale-or-unresolved | |
343 | (lambda () | |
344 | (string=? "iı" (string-locale-downcase "İI" %turkish-utf8-locale)))))) | |
5b3a39c7 LC |
345 | |
346 | \f | |
347 | (with-test-prefix "number parsing" | |
348 | ||
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))))) | |
354 | ||
355 | (pass-if "locale-string->inexact" | |
356 | (call-with-values | |
357 | (lambda () | |
358 | (locale-string->inexact "123.456" | |
a2f00b9b | 359 | (make-locale (list LC_NUMERIC) "C"))) |
5b3a39c7 LC |
360 | (lambda (result char-count) |
361 | (and (equal? result 123.456) | |
a2f00b9b LC |
362 | (equal? char-count 7))))) |
363 | ||
364 | (pass-if "locale-string->inexact (French)" | |
365 | (under-french-locale-or-unresolved | |
366 | (lambda () | |
367 | (call-with-values | |
368 | (lambda () | |
369 | (locale-string->inexact "123,456" %french-locale)) | |
370 | (lambda (result char-count) | |
371 | (and (equal? result 123.456) | |
372 | (equal? char-count 7)))))))) | |
373 | ||
374 | \f | |
375 | ;;; | |
376 | ;;; `nl-langinfo' | |
377 | ;;; | |
378 | ||
379 | (setlocale LC_ALL "C") | |
380 | (define %c-locale (make-locale LC_ALL "C")) | |
381 | ||
382 | (define %english-days | |
383 | '("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")) | |
384 | ||
385 | (define (every? . args) | |
386 | (not (not (apply every args)))) | |
387 | ||
388 | ||
389 | (with-test-prefix "nl-langinfo et al." | |
390 | ||
391 | (pass-if "locale-day (1 arg)" | |
392 | (every? equal? | |
393 | %english-days | |
394 | (map locale-day (map 1+ (iota 7))))) | |
395 | ||
396 | (pass-if "locale-day (2 args)" | |
397 | (every? equal? | |
398 | %english-days | |
399 | (map (lambda (day) | |
400 | (locale-day day %c-locale)) | |
401 | (map 1+ (iota 7))))) | |
402 | ||
403 | (pass-if "locale-day (2 args, using `%global-locale')" | |
404 | (every? equal? | |
405 | %english-days | |
406 | (map (lambda (day) | |
407 | (locale-day day %global-locale)) | |
408 | (map 1+ (iota 7))))) | |
409 | ||
410 | (pass-if "locale-day (French)" | |
411 | (under-french-locale-or-unresolved | |
412 | (lambda () | |
413 | (let ((result (locale-day 3 %french-locale))) | |
414 | (and (string? result) | |
415 | (string-ci=? result "mardi")))))) | |
416 | ||
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 | |
421 | (lambda () | |
422 | (dynamic-wind | |
423 | (lambda () | |
424 | (setlocale LC_TIME %french-locale-name)) | |
425 | (lambda () | |
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")))) | |
431 | (lambda () | |
432 | (setlocale LC_ALL "C")))))) | |
433 | ||
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 | |
437 | ;; "C". | |
438 | (under-french-locale-or-unresolved | |
439 | (lambda () | |
440 | (dynamic-wind | |
441 | (lambda () | |
442 | (setlocale LC_ALL %french-locale-name)) | |
443 | (lambda () | |
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")))) | |
449 | (lambda () | |
450 | (setlocale LC_ALL "C"))))))) | |
61d1d4a8 LC |
451 | |
452 | \f | |
453 | ;;; | |
454 | ;;; Numbers. | |
455 | ;;; | |
456 | ||
457 | (with-test-prefix "number->locale-string" | |
458 | ||
459 | ;; We assume the global locale is "C" at this point. | |
460 | ||
461 | (with-test-prefix "C" | |
462 | ||
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))) | |
467 | ||
468 | (pass-if "integer" | |
469 | (string=? "123456" (number->locale-string 123456))) | |
470 | ||
471 | (pass-if "fraction" | |
472 | (string=? "1234.567" (number->locale-string 1234.567))) | |
473 | ||
474 | (pass-if "fraction, 1 digit" | |
475 | (string=? "1234.5" (number->locale-string 1234.567 1)))) | |
476 | ||
477 | (with-test-prefix "French" | |
478 | ||
252f9f18 LC |
479 | (pass-if "integer" |
480 | (under-french-locale-or-unresolved | |
481 | (lambda () | |
482 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
483 | (string=? "123 456" (number->locale-string 123456 #t fr)))))) | |
61d1d4a8 | 484 | |
252f9f18 LC |
485 | (pass-if "fraction" |
486 | (under-french-locale-or-unresolved | |
487 | (lambda () | |
488 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
489 | (string=? "1 234,567" (number->locale-string 1234.567 #t fr)))))) | |
61d1d4a8 | 490 | |
252f9f18 LC |
491 | (pass-if "fraction, 1 digit" |
492 | (under-french-locale-or-unresolved | |
493 | (lambda () | |
494 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
495 | (string=? "1 234,5" | |
496 | (number->locale-string 1234.567 1 fr)))))))) | |
c76fdf69 | 497 | |
afd08fdf LC |
498 | (with-test-prefix "format ~h" |
499 | ||
13fb25ba LC |
500 | ;; Some systems like Darwin lack the `GROUPING' nl_item, and thus |
501 | ;; `locale-digit-grouping' defaults to '(); skip the tests in that | |
502 | ;; case. | |
503 | ||
afd08fdf LC |
504 | (with-test-prefix "French" |
505 | ||
506 | (pass-if "12345.5678" | |
507 | (under-french-locale-or-unresolved | |
508 | (lambda () | |
13fb25ba LC |
509 | (if (null? (locale-digit-grouping %french-locale)) |
510 | (throw 'unresolved) | |
511 | (string=? "12 345,6789" | |
512 | (format #f "~:h" 12345.6789 %french-locale))))))) | |
afd08fdf LC |
513 | |
514 | (with-test-prefix "English" | |
515 | ||
516 | (pass-if "12345.5678" | |
517 | (under-american-english-locale-or-unresolved | |
518 | (lambda () | |
13fb25ba LC |
519 | (if (null? (locale-digit-grouping %american-english-locale)) |
520 | (throw 'unresolved) | |
521 | (string=? "12,345.6789" | |
522 | (format #f "~:h" 12345.6789 | |
523 | %american-english-locale)))))))) | |
afd08fdf | 524 | |
c76fdf69 LC |
525 | (with-test-prefix "monetary-amount->locale-string" |
526 | ||
527 | (with-test-prefix "French" | |
528 | ||
529 | (pass-if "integer" | |
530 | (under-french-locale-or-unresolved | |
531 | (lambda () | |
532 | (let ((fr (make-locale LC_ALL %french-locale-name))) | |
533 | (string=? "123 456 +EUR" | |
534 | (monetary-amount->locale-string 123456 #f fr)))))) | |
535 | ||
536 | (pass-if "fraction" | |
537 | (under-french-locale-or-unresolved | |
538 | (lambda () | |
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)))))))) |