mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

In i18n test, modify locale testing to focus on UTF-8

Browse source 
fr_FR was mostly being tested as an 8-bit locale.  This changes
the tests to focus on fr_FR.utf8.  But it adds a section for fr_FR 8-bit
currency.  Divergence in vendor-supplied locales often occurs
in currency.

MINGW, which only handles 8-bit locales when using MSVCRT, was being tested
as if its 8-bit CP1252 locale was UTF-8.  While the tests were included
as better than nothing, it is technically incorrect. These tests are
no longer run. Soon, Guile's MINGW build will link to UCRT, and it will
have UTF-8 locales.

The responses for some tests were modified to allow reasonable responses
from Cygwin/MSYS/MinGW locales and to skip on unreasonable responses.

* test-suite/tests/i18n.test (mingw?): rename to old-ms?
  (old-ms?): new helper
  (%french-locale-name): use platform's default 8-bit locale
  (%french-utf8-locale-name, %turkish-utf8-locale-name, %german-utf8-locale-name)
  (%greek-utf8-locale-name): don't use 8-bit locales on MINGW
  ("text collation (French)"): use utf-8
  ("locale-digit-grouping (French)"): use utf-8
  (french-number-string=?): modify to make symmetric and to handle
     U+2024 as a valid spacer
  ("French: integer", "negative integer" "fraction", "fraction, 1 digit"):
  ("French"): rename to "French UTF-8"
  ("French UTF-8: 12345.678", "Fraction"): use utf-8, allow U+2024
  ("French UTF-8: positive inexact zero"): expect euro sign
  ("French 8-bit"): new currency tests
This commit is contained in:
Michael Gran 2023-06-20 11:10:33 -07:00
parent 1e0cf93a0a
commit e33dd7bfd8
1 changed files with 69 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

134
test-suite/tests/i18n.test
View file

@ -7,12 +7,12 @@
;;;; 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
@ -95,35 +95,36 @@
;; Old MS is MinGW using deprecated MSVCRT C library.
;; MinGW with UCRT C library prefers BCP 47 and can fall back to Old MS.
(define old-ms?
<<<<<<< HEAD
(and (string-contains %host-type "-mingw32")
(not (defined? '%UCRT))))
=======
(string-contains %host-type "-mingw32"))
>>>>>>> 8a3ba5975 (In i18n test, modify locale testing to focus on UTF-8)
(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.
(if old-ms?
"French_France" ; Usually CP1252
"fr_FR")) ; Probably Latin-1
(define %french-utf8-locale-name
(if mingw?
"fra_FRA.1252"
"fr_FR.utf8")) ;"utf8" is the "normalized codeset"
(if old-ms?
#f
"fr_FR.utf8"))
(define %turkish-utf8-locale-name
(if mingw?
"tur_TRK.1254"
(if old-ms?
#f
"tr_TR.utf8"))
(define %german-utf8-locale-name
(if mingw?
"deu_DEU.1252"
(if old-ms?
#f
"de_DE.utf8"))
(define %greek-utf8-locale-name
(if mingw?
"grc_ELL.1253"
(if old-ms?
#f
"el_GR.utf8"))
(define %american-english-locale-name
@ -203,19 +204,19 @@
(with-test-prefix "text collation (French)"
(pass-if "string-locale<?"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(string-locale<? "été" "hiver" %french-locale))))
(string-locale<? "été" "hiver" %french-utf8-locale))))
(pass-if "char-locale<?"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(char-locale<? #\é #\h %french-locale))))
(char-locale<? #\é #\h %french-utf8-locale))))
(pass-if "string-locale-ci=?"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(string-locale-ci=? "ÉTÉ" "été" %french-locale))))
(string-locale-ci=? "ÉTÉ" "été" %french-utf8-locale))))
(pass-if "string-locale-ci=? (2 args, wide strings)"
(under-french-utf8-locale-or-unresolved
@ -252,10 +253,10 @@
(string-locale-ci=? "œuf" "ŒUF" %french-utf8-locale))))
(pass-if "string-locale-ci<>?"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(and (string-locale-ci<? "été" "Hiver" %french-locale)
(string-locale-ci>? "HiVeR" "été" %french-locale)))))
(and (string-locale-ci<? "été" "Hiver" %french-utf8-locale)
(string-locale-ci>? "HiVeR" "été" %french-utf8-locale)))))
(pass-if "string-locale-ci<>? (wide strings)"
(under-french-utf8-locale-or-unresolved
@ -272,10 +273,10 @@
(string-locale-ci<? "Odyssée" "œdème" %french-utf8-locale)))))
(pass-if "char-locale-ci<>?"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(and (char-locale-ci<? #\é #\H %french-locale)
(char-locale-ci>? #\h #\É %french-locale)))))
(and (char-locale-ci<? #\é #\H %french-utf8-locale)
(char-locale-ci>? #\h #\É %french-utf8-locale)))))
(pass-if "char-locale-ci<>? (wide)"
(under-french-utf8-locale-or-unresolved
@ -436,11 +437,11 @@
(equal? char-count 7)))))
(pass-if "locale-string->inexact (French)"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(call-with-values
(lambda ()
(locale-string->inexact "123,456" %french-locale))
(locale-string->inexact "123,456" %french-utf8-locale))
(lambda (result char-count)
(and (equal? result 123.456)
(equal? char-count 7))))))))
@ -482,20 +483,20 @@
(map 1+ (iota 7)))))
(pass-if "locale-day (French)"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let ((result (locale-day 3 %french-locale)))
(let ((result (locale-day 3 %french-utf8-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
(under-french-utf8-locale-or-unresolved
(lambda ()
(dynamic-wind
(lambda ()
(setlocale LC_TIME %french-locale-name))
(setlocale LC_TIME %french-utf8-locale-name))
(lambda ()
(let* ((fr (make-locale (list LC_MONETARY) "C" %global-locale))
(result (locale-day 3 fr)))
@ -509,11 +510,11 @@
;; 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
(under-french-utf8-locale-or-unresolved
(lambda ()
(dynamic-wind
(lambda ()
(setlocale LC_ALL %french-locale-name))
(setlocale LC_ALL %french-utf8-locale-name))
(lambda ()
(let* ((locale (make-locale (list LC_MONETARY) "C"))
(result (locale-day 3 locale)))
@ -548,13 +549,13 @@
(null? (locale-digit-grouping)))
(pass-if "locale-digit-grouping (French)"
(under-french-locale-or-unresolved
(under-french-utf8-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)))
(let ((result (locale-digit-grouping %french-utf8-locale)))
(cond
((null? result)
(throw 'unresolved))
@ -605,14 +606,16 @@
;; 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)
;; used SPACE and some Windows locales use NARROW NO-BREAK SPACE.
(define (convert-space str)
(string-map (lambda (chr)
(case chr
((#\space) #\240)
(else chr))) ;NO-BREAK SPACE
expected)
result)))
((#\xa0) #\space)
((#\x202f) #\space)
(else chr)))
str))
(string=? (convert-space expected) (convert-space result)))
(with-test-prefix "number->locale-string"
@ -653,30 +656,30 @@
(with-test-prefix "French"
(pass-if "integer"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(let ((fr (make-locale LC_ALL %french-utf8-locale-name)))
(french-number-string=? "123 456"
(number->locale-string 123456 #t fr))))))
(pass-if "negative integer"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(let ((fr (make-locale LC_ALL %french-utf8-locale-name)))
(french-number-string=? "-1 234 567"
(number->locale-string -1234567 #t fr))))))
(pass-if "fraction"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(let ((fr (make-locale LC_ALL %french-utf8-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
(under-french-utf8-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-locale-name)))
(let ((fr (make-locale LC_ALL %french-utf8-locale-name)))
(french-number-string=? "1 234,6"
(number->locale-string 1234.567 1 fr))))))))
@ -689,13 +692,13 @@
(with-test-prefix "French"
(pass-if "12345.678"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(if (null? (locale-digit-grouping %french-locale))
(if (null? (locale-digit-grouping %french-utf8-locale))
(throw 'unresolved)
(french-number-string=? "12 345,678"
(format #f "~:h" 12345.678
%french-locale)))))))
%french-utf8-locale)))))))
(with-test-prefix "English"
@ -710,12 +713,12 @@
(with-test-prefix "monetary-amount->locale-string"
(with-test-prefix "French"
(with-test-prefix "French UTF-8"
(pass-if "integer"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let* ((fr (make-locale LC_ALL %french-locale-name))
(let* ((fr (make-locale LC_ALL %french-utf8-locale-name))
(str (string-trim-both (monetary-amount->locale-string 123456 #f fr))))
;; Check for
;; - U+20 SPACE
@ -727,9 +730,9 @@
(string=? "123\u202F456,00 €" str))))))
(pass-if "fraction"
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let* ((fr (make-locale LC_ALL %french-locale-name))
(let* ((fr (make-locale LC_ALL %french-utf8-locale-name))
(str (monetary-amount->locale-string 1234.567 #t fr)))
(when (locale-currency-symbol-precedes-positive? #t fr)
;; Locales that put EUR first are erroneous.
@ -739,7 +742,8 @@
;; - U+00A0 NO-BREAK SPACE
;; - U+202F NARROW NO BREAK SPACE
(or (string=? "1 234,57 EUR " str)
(string=? "1 234,57 EUR " str))))))
(string=? "1\xA0234,57 EUR " str)
(string=? "1\u202F234,57 EUR " str))))))
(pass-if "positive inexact zero"
(under-french-utf8-locale-or-unresolved
@ -752,7 +756,7 @@
(pass-if-equal "one cent"
"0,01 EUR "
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-utf8-locale-name)))
(when (locale-currency-symbol-precedes-positive? #t fr)
@ -762,7 +766,7 @@
(pass-if-equal "very little money"
"0,00 EUR "
(under-french-locale-or-unresolved
(under-french-utf8-locale-or-unresolved
(lambda ()
(let ((fr (make-locale LC_ALL %french-utf8-locale-name)))
(when (locale-currency-symbol-precedes-positive? #t fr)