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.

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, 
+    result = u32_strcoll ((const scm_t_uint32 *) c_s1,
-                         (const scm_t_uint32 *) c_s2);
+			  (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 
+    RUN_IN_LOCALE_SECTION
-      (c_locale, 
+      (c_locale,
-       result = u32_locale_casecoll (func_name, 
+       result = u32_locale_casecoll (func_name,
-                                     (const scm_t_uint32 *) c_s1, 
+				     (const scm_t_uint32 *) c_s1,
-                                     (const scm_t_uint32 *) c_s2)
+				     (const scm_t_uint32 *) c_s2);
-       );
   else
-    {
+    result = u32_locale_casecoll (func_name,
-      /* Passing NULL to u32_casecmp to do the default,
+				  (const scm_t_uint32 *) c_s1,
-         language-independent case folding. */
+				  (const scm_t_uint32 *) c_s2);
-      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);
-    }
 
   scm_remember_upto_here_2 (s1, s2);
   scm_remember_upto_here (locale);

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.
+;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
-;;;; Ludovic Courtès
+;;;; 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
+  (if locale
-      (catch 'system-error thunk
+      (if (string-contains %host-type "-gnu")
-             (lambda (key . args)
+          (thunk)
-               (throw 'unresolved)))
+          (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)
+        (and (string-locale-ci<? "été" "Hiver" %french-locale)
-             (string-locale-ci>? "HiVeR" "été" %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)
+         (and (char-locale-ci<? #\é #\H %french-locale)
-              (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: