mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
i18n: Always use locale-dependent string collation.
* libguile/i18n.c (compare_u32_strings, compare_u32_strings_ci): Always
use locale-dependent string collation.
* test-suite/tests/i18n.test: Recoded in UTF-8.
(%french-utf8-locale-name): New.
(under-locale-or-unresolved): New. Don't catch errors on GNU systems.
(under-french-locale-or-unresolved): Use it.
(under-french-utf8-locale-or-unresolved): New.
("text collation (French)")["string-locale-ci=? (2 args, wide
strings)", "string-locale-ci=? (3 args, wide strings)",
"string-locale-ci<>? (wide strings)", "string-locale-ci<>? (wide and
narrow strings)", "char-locale-ci<>? (wide)"]: New tests.
This commit is contained in:
Ludovic Courtès
parent
df047aa2b1
commit
cdf52ff020
2 changed files with 81 additions and 41 deletions
|
|
@ -766,8 +766,8 @@ compare_u32_strings (SCM s1, SCM s2, SCM locale, const char *func_name)
|
|||
result = u32_strcoll ((const scm_t_uint32 *) c_s1,
|
||||
(const scm_t_uint32 *) c_s2));
|
||||
else
|
||||
result = u32_strcmp ((const scm_t_uint32 *) c_s1,
|
||||
(const scm_t_uint32 *) c_s2);
|
||||
result = u32_strcoll ((const scm_t_uint32 *) c_s1,
|
||||
(const scm_t_uint32 *) c_s2);
|
||||
|
||||
scm_remember_upto_here_2 (s1, s2);
|
||||
scm_remember_upto_here (locale);
|
||||
|
|
@ -796,7 +796,7 @@ static inline int
|
|||
compare_u32_strings_ci (SCM s1, SCM s2, SCM locale, const char *func_name)
|
||||
#define FUNC_NAME func_name
|
||||
{
|
||||
int ret, result;
|
||||
int result;
|
||||
scm_t_locale c_locale;
|
||||
scm_t_wchar *c_s1, *c_s2;
|
||||
SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
|
||||
|
|
@ -805,24 +805,15 @@ compare_u32_strings_ci (SCM s1, SCM s2, SCM locale, const char *func_name)
|
|||
SCM_STRING_TO_U32_BUF (s2, c_s2);
|
||||
|
||||
if (c_locale)
|
||||
RUN_IN_LOCALE_SECTION
|
||||
(c_locale,
|
||||
result = u32_locale_casecoll (func_name,
|
||||
(const scm_t_uint32 *) c_s1,
|
||||
(const scm_t_uint32 *) c_s2)
|
||||
);
|
||||
RUN_IN_LOCALE_SECTION
|
||||
(c_locale,
|
||||
result = u32_locale_casecoll (func_name,
|
||||
(const scm_t_uint32 *) c_s1,
|
||||
(const scm_t_uint32 *) c_s2);
|
||||
else
|
||||
{
|
||||
/* Passing NULL to u32_casecmp to do the default,
|
||||
language-independent case folding. */
|
||||
ret = u32_casecmp ((const scm_t_uint32 *) c_s1,
|
||||
u32_strlen ((const scm_t_uint32 *) c_s1),
|
||||
(const scm_t_uint32 *) c_s2,
|
||||
u32_strlen ((const scm_t_uint32 *) c_s2),
|
||||
NULL, UNINORM_NFC, &result);
|
||||
if (ret != 0)
|
||||
scm_syserror (func_name);
|
||||
}
|
||||
result = u32_locale_casecoll (func_name,
|
||||
(const scm_t_uint32 *) c_s1,
|
||||
(const scm_t_uint32 *) c_s2);
|
||||
|
||||
scm_remember_upto_here_2 (s1, s2);
|
||||
scm_remember_upto_here (locale);
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;;; i18n.test --- Exercise the i18n API.
|
||||
;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*-
|
||||
;;;;
|
||||
;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
|
||||
;;;; Ludovic Courtès
|
||||
;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
|
||||
;;;; 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
|
||||
|
|
@ -82,49 +82,104 @@
|
|||
(define %french-locale-name
|
||||
"fr_FR.ISO-8859-1")
|
||||
|
||||
(define %french-utf8-locale-name
|
||||
"fr_FR.UTF-8")
|
||||
|
||||
(define %french-locale
|
||||
(false-if-exception
|
||||
(make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
|
||||
%french-locale-name)))
|
||||
|
||||
(define (under-french-locale-or-unresolved thunk)
|
||||
(define %french-utf8-locale
|
||||
(false-if-exception
|
||||
(make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
|
||||
%french-utf8-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 %french-locale
|
||||
(catch 'system-error thunk
|
||||
(lambda (key . args)
|
||||
(throw 'unresolved)))
|
||||
(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))
|
||||
|
||||
|
||||
(with-test-prefix "text collation (French)"
|
||||
|
||||
(pass-if "string-locale<?"
|
||||
(under-french-locale-or-unresolved
|
||||
(lambda ()
|
||||
(string-locale<? "été" "hiver" %french-locale))))
|
||||
(string-locale<? "été" "hiver" %french-locale))))
|
||||
|
||||
(pass-if "char-locale<?"
|
||||
(under-french-locale-or-unresolved
|
||||
(lambda ()
|
||||
(char-locale<? #\é #\h %french-locale))))
|
||||
(char-locale<? #\é #\h %french-locale))))
|
||||
|
||||
(pass-if "string-locale-ci=?"
|
||||
(under-french-locale-or-unresolved
|
||||
(lambda ()
|
||||
(string-locale-ci=? "ÉTÉ" "été" %french-locale))))
|
||||
(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 "fr_FR.UTF-8"))
|
||||
(lambda ()
|
||||
(string-locale-ci=? "œuf" "ŒUF"))
|
||||
(lambda ()
|
||||
(setlocale LC_ALL "C"))))))
|
||||
|
||||
(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)))))
|
||||
(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))))))
|
||||
(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 "character mapping"
|
||||
|
|
@ -242,9 +297,3 @@
|
|||
(string-ci=? result "Tuesday"))))
|
||||
(lambda ()
|
||||
(setlocale LC_ALL "C")))))))
|
||||
|
||||
|
||||
;;; Local Variables:
|
||||
;;; coding: latin-1
|
||||
;;; mode: scheme
|
||||
;;; End:
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue