diff --git a/libguile/i18n.c b/libguile/i18n.c index 0db31fa24..cab4a7de0 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -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); diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test index c4777c21c..6bfdbc78f 100644 --- a/test-suite/tests/i18n.test +++ b/test-suite/tests/i18n.test @@ -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 () - (and (string-locale-ci? "HiVeR" "été" %french-locale))))) + (and (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? "Å’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?" (under-french-locale-or-unresolved (lambda () - (and (char-locale-ci? #\h #\É %french-locale)))))) + (and (char-locale-ci? #\h #\É %french-locale))))) + + (pass-if "char-locale-ci<>? (wide)" + (under-french-utf8-locale-or-unresolved + (lambda () + (and (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: