1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
guile/test-suite/tests/i18n.test
Andy Wingo 9e32c5729e Fix recent i18n tests
* test-suite/tests/i18n.test ("text collation (French)"): Fix to
actually pass locale arg.
2021-03-16 21:55:22 +01:00

743 lines
25 KiB
Scheme
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*-
;;;;
;;;; Copyright (C) 2006-2007,2009-2019,2021 Free Software Foundation, Inc.
;;;; Author: Ludovic Courtès
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite i18n)
#:use-module (ice-9 i18n)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (test-suite lib))
;; Start from a pristine locale state.
(setlocale LC_ALL "C")
(define exception:locale-error
(cons 'system-error "Failed to install locale"))
(with-test-prefix "locale objects"
(pass-if "make-locale (2 args)"
(not (not (make-locale LC_ALL "C"))))
(pass-if "make-locale (2 args, list)"
(not (not (make-locale (list LC_COLLATE LC_NUMERIC) "C"))))
(pass-if "make-locale (3 args)"
(not (not (make-locale (list LC_COLLATE) "C"
(make-locale (list LC_NUMERIC) "C")))))
(pass-if-exception "make-locale with unknown locale" exception:locale-error
(make-locale LC_ALL "does-not-exist"))
(pass-if "locale?"
(and (locale? (make-locale (list LC_ALL) "C"))
(locale? (make-locale (list LC_TIME LC_NUMERIC) "C"
(make-locale (list LC_CTYPE) "C")))))
(pass-if "%global-locale"
(and (locale? %global-locale))
(locale? (make-locale (list LC_MONETARY) "C"
%global-locale))))
(with-test-prefix "text collation (English)"
(pass-if "string-locale<?"
(and (string-locale<? "hello" "world")
(string-locale<? "hello" "world"
(make-locale (list LC_COLLATE) "C"))))
(pass-if "char-locale<?"
(and (char-locale<? #\a #\b)
(char-locale<? #\a #\b (make-locale (list LC_COLLATE) "C"))))
(pass-if "string-locale-ci=?"
(and (string-locale-ci=? "Hello" "HELLO")
(string-locale-ci=? "Hello" "HELLO"
(make-locale (list LC_COLLATE) "C"))))
(pass-if "string-locale-ci<?"
(and (string-locale-ci<? "hello" "WORLD")
(string-locale-ci<? "hello" "WORLD"
(make-locale (list LC_COLLATE) "C"))))
(pass-if "large strings"
;; In Guile <= 2.2.4, these would overflow the C stack and crash.
(let ((large (make-string 4000000 #\a)))
(and (string-locale-ci=? large large)
(not (string-locale-ci<? large large))
(not (string-locale<? large large))))))
(define mingw?
(string-contains %host-type "-mingw32"))
(define %french-locale-name
(if mingw?
"fra_FRA.850"
"fr_FR.iso88591")) ;"iso88591" is the "normalized codeset"
;; What we really want for the following locales is that they be Unicode
;; capable, not necessarily UTF-8, which Windows does not provide.
(define %french-utf8-locale-name
(if mingw?
"fra_FRA.1252"
"fr_FR.utf8")) ;"utf8" is the "normalized codeset"
(define %turkish-utf8-locale-name
(if mingw?
"tur_TRK.1254"
"tr_TR.utf8"))
(define %german-utf8-locale-name
(if mingw?
"deu_DEU.1252"
"de_DE.utf8"))
(define %greek-utf8-locale-name
(if mingw?
"grc_ELL.1253"
"el_GR.utf8"))
(define %american-english-locale-name
"en_US.utf8")
(define %french-locale
(false-if-exception
(make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME LC_MONETARY)
%french-locale-name)))
(define %french-utf8-locale
(false-if-exception
(make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME LC_MONETARY)
%french-utf8-locale-name)))
(define %german-utf8-locale
(false-if-exception
(make-locale LC_ALL
%german-utf8-locale-name)))
(define %greek-utf8-locale
(false-if-exception
(make-locale LC_ALL
%greek-utf8-locale-name)))
(define %turkish-utf8-locale
(false-if-exception
(make-locale LC_ALL
%turkish-utf8-locale-name)))
(define %american-english-locale
(false-if-exception
(make-locale LC_ALL
%american-english-locale-name)))
(define (under-locale-or-unresolved locale thunk)
;; On non-GNU systems, an exception may be raised only when the locale is
;; actually used rather than at `make-locale'-time. Thus, we must guard
;; against both.
(if locale
(if (string-contains %host-type "-gnu")
(thunk)
(catch 'system-error thunk
(lambda (key . args)
(throw 'unresolved))))
(throw 'unresolved)))
(define (under-french-locale-or-unresolved thunk)
(under-locale-or-unresolved %french-locale thunk))
(define (under-french-utf8-locale-or-unresolved thunk)
(under-locale-or-unresolved %french-utf8-locale thunk))
(define (under-turkish-utf8-locale-or-unresolved thunk)
;; FreeBSD 8.2 and 9.1, Solaris 2.10, Darwin 8.11.0, Cygwin, and MinGW have
;; a broken tr_TR locale where `i' is mapped to uppercase `I'
;; instead of `İ', so disable tests on that platform.
(if (or (string-contains %host-type "freebsd8")
(string-contains %host-type "freebsd9")
(string-contains %host-type "solaris2.10")
(string-contains %host-type "darwin8")
(string-contains %host-type "mingw32")
(string-contains %host-type "cygwin"))
(throw 'unresolved)
(under-locale-or-unresolved %turkish-utf8-locale thunk)))
(define (under-german-utf8-locale-or-unresolved thunk)
(under-locale-or-unresolved %german-utf8-locale thunk))
(define (under-greek-utf8-locale-or-unresolved thunk)
(under-locale-or-unresolved %greek-utf8-locale thunk))
(define (under-american-english-locale-or-unresolved thunk)
(under-locale-or-unresolved %american-english-locale thunk))
(with-test-prefix "text collation (French)"
(pass-if "string-locale<?"
(under-french-locale-or-unresolved
(lambda ()
(string-locale<? "été" "hiver" %french-locale))))
(pass-if "char-locale<?"
(under-french-locale-or-unresolved
(lambda ()
(char-locale<? #\é #\h %french-locale))))
(pass-if "string-locale-ci=?"
(under-french-locale-or-unresolved
(lambda ()
(string-locale-ci=? "ÉTÉ" "été" %french-locale))))
(pass-if "string-locale-ci=? (2 args, wide strings)"
(under-french-utf8-locale-or-unresolved
(lambda ()
;; Note: Character `œ' is not part of Latin-1, so these are wide
;; strings.
(dynamic-wind
(lambda ()
(setlocale LC_ALL %french-utf8-locale-name))
(lambda ()
(string-locale-ci=? "œuf" "ŒUF"))
(lambda ()
(setlocale LC_ALL "C"))))))
(pass-if "string-locale<?, bis"
(under-french-utf8-locale-or-unresolved
(lambda ()
(let* ((strings (list "œa" "œb"))
(heads (map (lambda (s) (substring/shared s 0 1)) strings)))
(not (string-locale<? (car heads) (cadr heads)
%french-utf8-locale))))))
(pass-if "string-locale-ci=?, bis"
(under-french-utf8-locale-or-unresolved
(lambda ()
(let* ((strings (list "œa" "œb"))
(heads (map (lambda (s) (substring/shared s 0 1)) strings)))
(string-locale-ci=? (car heads) (cadr heads)
%french-utf8-locale)))))
(pass-if "string-locale-ci=? (3 args, wide strings)"
(under-french-utf8-locale-or-unresolved
(lambda ()
(string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale))))
(pass-if "string-locale-ci<>?"
(under-french-locale-or-unresolved
(lambda ()
(and (string-locale-ci<? "été" "Hiver" %french-locale)
(string-locale-ci>? "HiVeR" "été" %french-locale)))))
(pass-if "string-locale-ci<>? (wide strings)"
(under-french-utf8-locale-or-unresolved
(lambda ()
;; One of the strings is UCS-4, the other is Latin-1.
(and (string-locale-ci<? "Œdème" "œuf" %french-utf8-locale)
(string-locale-ci>? "Œuf" "œdÈMe" %french-utf8-locale)))))
(pass-if "string-locale-ci<>? (wide and narrow strings)"
(under-french-utf8-locale-or-unresolved
(lambda ()
;; One of the strings is UCS-4, the other is Latin-1.
(and (string-locale-ci>? "Œdème" "odyssée" %french-utf8-locale)
(string-locale-ci<? "Odyssée" "œdème" %french-utf8-locale)))))
(pass-if "char-locale-ci<>?"
(under-french-locale-or-unresolved
(lambda ()
(and (char-locale-ci<? #\é #\H %french-locale)
(char-locale-ci>? #\h #\É %french-locale)))))
(pass-if "char-locale-ci<>? (wide)"
(under-french-utf8-locale-or-unresolved
(lambda ()
(and (char-locale-ci<? #\o #\œ %french-utf8-locale)
(char-locale-ci>? #\Œ #\e %french-utf8-locale))))))
(with-test-prefix "text collation (German)"
(pass-if "string-locale-ci=?"
(under-german-utf8-locale-or-unresolved
(lambda ()
(let ((de (make-locale LC_ALL %german-utf8-locale-name)))
(string-locale-ci=? "Straße" "STRASSE"))))))
(with-test-prefix "text collation (Greek)"
(pass-if "string-locale-ci=?"
(under-greek-utf8-locale-or-unresolved
(lambda ()
(let ((gr (make-locale LC_ALL %greek-utf8-locale-name)))
(string-locale-ci=? "ΧΑΟΣ" "χαος" gr))))))
(with-test-prefix "text collation (Czech)"
(pass-if "string-locale<? for 'ch'"
(under-locale-or-unresolved
"cs_CZ.utf8"
(lambda ()
;; Czech sorts digraph 'ch' between 'h' and 'i'.
;;
;; GNU libc 2.22 gets this wrong:
;; <https://sourceware.org/bugzilla/show_bug.cgi?id=18589>. For
;; now, just skip it if it fails (XXX).
(or (and (string-locale>? "chxxx" "cxxx")
(string-locale>? "chxxx" "hxxx")
(string-locale<? "chxxxx" "ixxx"))
(throw 'unresolved))))))
(with-test-prefix "character mapping"
(pass-if "char-locale-downcase"
(and (eqv? #\a (char-locale-downcase #\A))
(eqv? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
(pass-if "char-locale-upcase"
(and (eqv? #\Z (char-locale-upcase #\z))
(eqv? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
(pass-if "char-locale-titlecase"
(and (eqv? #\T (char-locale-titlecase #\t))
(eqv? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
(pass-if "char-locale-titlecase Dž"
(and (eqv? #\762 (char-locale-titlecase #\763))
(eqv? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
(pass-if "char-locale-upcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
(eqv? #\İ (char-locale-upcase #\i %turkish-utf8-locale)))))
(pass-if "char-locale-downcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
(eqv? #\i (char-locale-downcase #\İ %turkish-utf8-locale))))))
(with-test-prefix "string mapping"
(pass-if "string-locale-downcase"
(and (string=? "a" (string-locale-downcase "A"))
(string=? "a" (string-locale-downcase "A" (make-locale LC_ALL "C")))))
(pass-if "string-locale-upcase"
(and (string=? "Z" (string-locale-upcase "z"))
(string=? "Z" (string-locale-upcase "z" (make-locale LC_ALL "C")))))
(pass-if "string-locale-titlecase"
(and (string=? "Hello, World" (string-locale-titlecase "hello, world"))
(string=? "Hello, World" (string-locale-titlecase
"hello, world" (make-locale LC_ALL "C")))))
(pass-if "large strings"
;; In Guile <= 2.2.4, these would overflow the C stack and crash.
(let ((hellos (string-join (make-list 700000 "hello")))
(HELLOs (string-join (make-list 700000 "HELLO")))
(Hellos (string-join (make-list 700000 "Hello"))))
(and (string=? hellos (string-locale-downcase Hellos))
(string=? HELLOs (string-locale-upcase Hellos))
(string=? Hellos (string-locale-titlecase hellos)))))
(pass-if "string-locale-upcase German"
(under-german-utf8-locale-or-unresolved
(lambda ()
(let ((de (make-locale LC_ALL %german-utf8-locale-name)))
(string=? "STRASSE"
(string-locale-upcase "Straße" de))))))
(pass-if "string-locale-upcase Greek"
(under-greek-utf8-locale-or-unresolved
(lambda ()
(let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
(string=? "ΧΑΟΣ"
(string-locale-upcase "χαος" el))))))
(pass-if "string-locale-upcase Greek (two sigmas)"
(under-greek-utf8-locale-or-unresolved
(lambda ()
(let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
(string=? "ΓΕΙΆ ΣΑΣ"
(string-locale-upcase "Γειά σας" el))))))
(pass-if "string-locale-downcase Greek"
(under-greek-utf8-locale-or-unresolved
(lambda ()
(let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
(string=? "χαος"
(string-locale-downcase "ΧΑΟΣ" el))))))
(pass-if "string-locale-downcase Greek (two sigmas)"
(under-greek-utf8-locale-or-unresolved
(lambda ()
(let ((el (make-locale LC_ALL %greek-utf8-locale-name)))
(string=? "γειά σας"
(string-locale-downcase "ΓΕΙΆ ΣΑΣ" el))))))
(pass-if "string-locale-upcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
(string=? "İI" (string-locale-upcase "iı" %turkish-utf8-locale)))))
(pass-if "string-locale-downcase Turkish"
(under-turkish-utf8-locale-or-unresolved
(lambda ()
(string=? "iı" (string-locale-downcase "İI" %turkish-utf8-locale))))))
(with-test-prefix "number parsing"
(pass-if "locale-string->integer"
(call-with-values (lambda () (locale-string->integer "123"))
(lambda (result char-count)
(and (equal? result 123)
(equal? char-count 3)))))
(pass-if "locale-string->inexact"
(call-with-values
(lambda ()
(locale-string->inexact "123.456"
(make-locale (list LC_NUMERIC) "C")))
(lambda (result char-count)
(and (equal? result 123.456)
(equal? char-count 7)))))
(pass-if "locale-string->inexact (French)"
(under-french-locale-or-unresolved
(lambda ()
(call-with-values
(lambda ()
(locale-string->inexact "123,456" %french-locale))
(lambda (result char-count)
(and (equal? result 123.456)
(equal? char-count 7))))))))
;;;
;;; `nl-langinfo'
;;;
(setlocale LC_ALL "C")
(define %c-locale (make-locale LC_ALL "C"))
(define %english-days
'("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
(define (every? . args)
(not (not (apply every args))))
(with-test-prefix "nl-langinfo et al."
(pass-if "locale-day (1 arg)"
(every? equal?
%english-days
(map locale-day (map 1+ (iota 7)))))
(pass-if "locale-day (2 args)"
(every? equal?
%english-days
(map (lambda (day)
(locale-day day %c-locale))
(map 1+ (iota 7)))))
(pass-if "locale-day (2 args, using `%global-locale')"
(every? equal?
%english-days
(map (lambda (day)
(locale-day day %global-locale))
(map 1+ (iota 7)))))
(pass-if "locale-day (French)"
(under-french-locale-or-unresolved
(lambda ()
(let ((result (locale-day 3 %french-locale)))
(and (string? result)
(string-ci=? result "mardi"))))))
(pass-if "locale-day (French, using `%global-locale')"
;; Make sure `%global-locale' captures the current locale settings as
;; installed using `setlocale'.
(under-french-locale-or-unresolved
(lambda ()
(dynamic-wind
(lambda ()
(setlocale LC_TIME %french-locale-name))
(lambda ()
(let* ((fr (make-locale (list LC_MONETARY) "C" %global-locale))
(result (locale-day 3 fr)))
(setlocale LC_ALL "C")
(and (string? result)
(string-ci=? result "mardi"))))
(lambda ()
(setlocale LC_ALL "C"))))))
(pass-if "default locale"
;; Make sure the default locale does not capture the current locale
;; settings as installed using `setlocale'. The default locale should be
;; "C".
(under-french-locale-or-unresolved
(lambda ()
(dynamic-wind
(lambda ()
(setlocale LC_ALL %french-locale-name))
(lambda ()
(let* ((locale (make-locale (list LC_MONETARY) "C"))
(result (locale-day 3 locale)))
(setlocale LC_ALL "C")
(and (string? result)
(string-ci=? result "Tuesday"))))
(lambda ()
(setlocale LC_ALL "C"))))))
(pass-if "locale-am-string"
(not (not (member (locale-am-string)
'("AM" "am" "A.M." "a.m.")))))
(pass-if "locale-am-string (greek)"
(under-greek-utf8-locale-or-unresolved
(lambda ()
(not (not (member (locale-am-string %greek-utf8-locale)
'("ΠΜ" "πμ" "Π.Μ." "π.μ.")))))))
(pass-if "locale-pm-string"
(not (not (member (locale-pm-string)
'("PM" "pm" "P.M." "p.m.")))))
(pass-if "locale-pm-string (Greek)"
(under-greek-utf8-locale-or-unresolved
(lambda ()
(not (not (member (locale-pm-string %greek-utf8-locale)
'("ΜΜ" "μμ" "Μ.Μ." "μ.μ.")))))))
(pass-if "locale-digit-grouping"
;; In the C locale, there is no rule for grouping.
(null? (locale-digit-grouping)))
(pass-if "locale-digit-grouping (French)"
(under-french-locale-or-unresolved
(lambda ()
;; All systems that have a GROUPING nl_item should know
;; that French numbers are grouped in 3 digit chunks.
;; Those systems that have no GROUPING nl_item may use
;; the hard-coded default of no grouping.
(let ((result (locale-digit-grouping %french-locale)))
(cond
((null? result)
(throw 'unresolved))
((eqv? 3 (false-if-exception (car result)))
#t)
(else
#f))))))
(pass-if "locale-positive-separated-by-space?"
;; In any locale, this must be a boolean.
(let ((result (locale-positive-separated-by-space? #f)))
(or (eqv? #t result)
(eqv? #f result))))
(pass-if "locale-positive-separated-by-space? (international)"
;; In any locale, this must be a boolean.
(let ((result (locale-positive-separated-by-space? #t)))
(or (eqv? #t result)
(eqv? #f result))))
(pass-if "locale-monetary-grouping"
;; In the C locale, there is no rule for grouping of digits
;; of monetary values.
(null? (locale-monetary-grouping)))
(pass-if "locale-monetary-grouping (French)"
(under-french-utf8-locale-or-unresolved
(lambda ()
;; All systems that have a MON_GROUPING nl_item should know
;; that French monetary values are grouped in 3 digit chunks.
;; Those systems that have no MON_GROUPING nl_item may use the
;; hard-coded default of no grouping.
(let ((result (locale-monetary-grouping %french-utf8-locale)))
(cond
((null? result)
(throw 'unresolved))
((eqv? 3 (false-if-exception (car result)))
#t)
(else
#f)))))))
;;;
;;; Numbers.
;;;
(define (french-number-string=? expected result)
;; Return true if RESULT is equal to EXPECTED, modulo white space.
;; This is meant to deal with French locales: glibc 2.27+ uses
;; NO-BREAK SPACE to separate 3-digit groups, whereas earlier versions
;; used SPACE.
(or (string=? expected result)
(string=? (string-map (lambda (chr)
(case chr
((#\space) #\240)
(else chr))) ;NO-BREAK SPACE
expected)
result)))
(with-test-prefix "number->locale-string"
;; We assume the global locale is "C" at this point.
(with-test-prefix "C"
(pass-if-equal "no thousand separator"
""
;; Unlike in English, the "C" locale has no thousand separator.
;; If this doesn't hold, the following tests will fail.
(locale-thousands-separator))
(pass-if-equal "integer"
"123456"
(number->locale-string 123456))
(pass-if-equal "fraction"
"1234.567"
(number->locale-string 1234.567))
(pass-if-equal "fraction, 1 digit"
"1234.6"
(number->locale-string 1234.567 1))
(pass-if-equal "fraction, 10 digits"
"0.0000300000"
(number->locale-string .00003 10))
(pass-if-equal "trailing zeros"
"-10.00000"
(number->locale-string -10.0 5))
(pass-if-equal "positive inexact zero, 1 digit"
"0.0"
(number->locale-string .0 1)))
(with-test-prefix "French"
(pass-if "integer"
(under-french-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(french-number-string=? "123 456"
(number->locale-string 123456 #t fr))))))
(pass-if "negative integer"
(under-french-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(french-number-string=? "-1 234 567"
(number->locale-string -1234567 #t fr))))))
(pass-if "fraction"
(under-french-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(french-number-string=? "1 234,567"
(number->locale-string 1234.567 #t fr))))))
(pass-if "fraction, 1 digit"
(under-french-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(french-number-string=? "1 234,6"
(number->locale-string 1234.567 1 fr))))))))
(with-test-prefix "format ~h"
;; Some systems like Darwin lack the `GROUPING' nl_item, and thus
;; `locale-digit-grouping' defaults to '(); skip the tests in that
;; case.
(with-test-prefix "French"
(pass-if "12345.678"
(under-french-locale-or-unresolved
(lambda ()
(if (null? (locale-digit-grouping %french-locale))
(throw 'unresolved)
(french-number-string=? "12 345,678"
(format #f "~:h" 12345.678
%french-locale)))))))
(with-test-prefix "English"
(pass-if-equal "12345.678"
"12,345.678"
(under-american-english-locale-or-unresolved
(lambda ()
(if (null? (locale-digit-grouping %american-english-locale))
(throw 'unresolved)
(format #f "~:h" 12345.678
%american-english-locale)))))))
(with-test-prefix "monetary-amount->locale-string"
(with-test-prefix "French"
(pass-if "integer"
(under-french-locale-or-unresolved
(lambda ()
(let* ((fr (make-locale LC_ALL %french-locale-name))
(str (string-trim-both (monetary-amount->locale-string 123456 #f fr))))
;; Check for both NO-BREAK SPACE and SPACE.
(or (string=? "123 456,00 +EUR" str)
(string=? "123 456,00 +EUR" str))))))
(pass-if "fraction"
(under-french-locale-or-unresolved
(lambda ()
(let* ((fr (make-locale LC_ALL %french-locale-name))
(str (monetary-amount->locale-string 1234.567 #t fr)))
;; Check for both NO-BREAK SPACE and SPACE.
(or (string=? "1 234,57 EUR " str)
(string=? "1 234,57 EUR " str))))))
(pass-if-equal "positive inexact zero"
"0,00 +EUR"
(under-french-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(string-trim-both (monetary-amount->locale-string 0. #f fr))))))
(pass-if-equal "one cent"
"0,01 EUR "
(under-french-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(monetary-amount->locale-string .01 #t fr)))))
(pass-if-equal "very little money"
"0,00 EUR "
(under-french-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(monetary-amount->locale-string .00003 #t fr)))))))