[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-34-gaafb506

[Michael Gran]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=aafb5062b834dc468fa2acdec7eda12e389c5bca

The branch, master has been updated
       via  aafb5062b834dc468fa2acdec7eda12e389c5bca (commit)
       via  bcccf04158bda5319776d45abd6cc748b794096b (commit)
       via  2c48e4d5b7c5f33f8ddc2ce9c381c9f51ce7b579 (commit)
      from  76e8a7588c7cdbdfe96be81366fe9ef43960423f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit aafb5062b834dc468fa2acdec7eda12e389c5bca
Author: Michael Gran <address@hidden>
Date:   Thu Sep 24 08:07:38 2009 -0700

    Language-specific case-conversion doesn't honor locale
    
    Libunistring uses a function uc_locale_language to extract the
    current language from the locale information.  It does this by calling
    setlocale.  This makes incompatible with Guile functions that use the
    locale_t thread-specific locale API, because the values returned by the
    call to setlocale ignore the locale set by uselocale.
    
    As a workaround, this patch extracts the language from the locale_t
    structure's __names field.
    
    A more complete solution is needed.  Perhaps that solution would test
    that the __names field exists in the configure step and revert to
    !USE_GNU_LOCALE_API in that case.
    
    * libguile/i18n.c (locale_language): new function that performs the
      same job as uc_locale_language but is compatible with uselocale
      (u32_locale_casecoll, u32_locale_tocase): replace uc_locale_language
      with locale_language

commit bcccf04158bda5319776d45abd6cc748b794096b
Author: Michael Gran <address@hidden>
Date:   Thu Sep 24 08:10:03 2009 -0700

    Tests for locale-specific case conversion
    
    * test-suite/tests/i18n.test: add tests for case conversion of Turkish
      letters 'i' to verify that the language is being honored.

commit 2c48e4d5b7c5f33f8ddc2ce9c381c9f51ce7b579
Author: Michael Gran <address@hidden>
Date:   Thu Sep 24 07:50:49 2009 -0700

    Try to adjust i18n for strict aliasing
    
    * libguile/i18n.c (u32_locale_tocase, scm_char_locale_downcase)
      (scm_char_locale_upcase, scm_string_locale_downcase)
      (scm_string_locale_upcase): use the scm_t_uint32 type for buffers
      that are used primarily for libunistring and not for Guile strings.

-----------------------------------------------------------------------

Summary of changes:
 libguile/i18n.c            |   88 ++++++++++++++++++++++++++++++++++----------
 test-suite/tests/i18n.test |   43 +++++++++++++++++++++-
 2 files changed, 110 insertions(+), 21 deletions(-)

diff --git a/libguile/i18n.c b/libguile/i18n.c
index 449f0a5..e7462c3 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -775,8 +775,52 @@ compare_u32_strings (SCM s1, SCM s2, SCM locale, const 
char *func_name)
 }
 #undef FUNC_NAME
 
+/* Return the current language of the locale. */
+static const char *
+locale_language ()
+{
+#ifdef USE_GNU_LOCALE_API
+  {
+    static char lang[10];
+    scm_t_locale loc;
+    const char *c_result;
+    char *p;
+
+    /* If we are here, the locale has been set with 'uselocale'.  We
+       can't use libunistring's uc_locale_language because it calls
+       setlocale.  */
+    loc = uselocale (0);
+    if (loc == (scm_t_locale) -1)
+      return "";
+
+    /* The internal structure of locale_t may be specific to the C
+       library, but, there doesn't seem to be any other way to extract
+       the locale name.  */
+    c_result = loc->__names[LC_CTYPE];
+    p = (char *) c_result;
+    while (*p != '\0' && *p != '_' && *p != '.' && *p != '@')
+      p++;
+
+    /* Return a statically allocated pointer to the language portion,
+       so that the caller of this function does not need to free() the
+       result.  */
+    if (p != c_result)
+      {
+        memcpy (lang, c_result, p - c_result);
+        lang[p - c_result] = '\0';
+        return lang;
+      }
+    else
+      return "";
+  }
+#else
+  /* The locale has been set with setlocale.  */
+  return uc_locale_language ();
+#endif
+}
+
 static inline int
-u32_locale_casecoll (const char *func_name, const scm_t_uint32 *c_s1, 
+u32_locale_casecoll (const char *func_name, const scm_t_uint32 *c_s1,
                      const scm_t_uint32 *c_s2,
                     int *result)
 {
@@ -784,9 +828,9 @@ u32_locale_casecoll (const char *func_name, const 
scm_t_uint32 *c_s1,
      make any non-local exit.  */
 
   int ret;
-  const char *loc = uc_locale_language ();
+  const char *loc = locale_language ();
 
-  ret = u32_casecoll (c_s1, u32_strlen (c_s1), 
+  ret = u32_casecoll (c_s1, u32_strlen (c_s1),
                       c_s2, u32_strlen (c_s2),
                       loc, UNINORM_NFC, result);
 
@@ -1081,7 +1125,7 @@ u32_locale_tocase (const scm_t_uint32 *c_s1, size_t len,
      make any non-local exit.  */
 
   scm_t_uint32 *ret;
-  const char *loc = uc_locale_language ();
+  const char *loc = locale_language ();
 
   /* The first NULL here indicates that no NFC or NFKC normalization
      is done.  The second NULL means the return buffer is
@@ -1090,12 +1134,12 @@ u32_locale_tocase (const scm_t_uint32 *c_s1, size_t len,
 
   if (ret == NULL)
     {
-      *p_c_s2 = NULL;
+      *p_c_s2 = (scm_t_uint32 *) NULL;
       *p_len2 = 0;
       return errno;
     }
   *p_c_s2 = ret;
-  
+
   return 0;
 }
 
@@ -1109,7 +1153,8 @@ SCM_DEFINE (scm_char_locale_downcase, 
"char-locale-downcase", 1, 1, 0,
 {
   int ret;
   scm_t_locale c_locale;
-  scm_t_wchar *buf, *downbuf;
+  scm_t_wchar *buf;
+  scm_t_uint32 *downbuf;
   size_t downlen;
   SCM str, downchar;
 
@@ -1122,11 +1167,11 @@ SCM_DEFINE (scm_char_locale_downcase, 
"char-locale-downcase", 1, 1, 0,
   if (c_locale != NULL)
     RUN_IN_LOCALE_SECTION (c_locale, ret =
                            u32_locale_tocase ((scm_t_uint32 *) buf, 1,
-                                              (scm_t_uint32 **) &downbuf,
+                                              &downbuf,
                                               &downlen, u32_tolower));
   else
     ret =
-      u32_locale_tocase ((scm_t_uint32 *) buf, 1, (scm_t_uint32 **) &downbuf,
+      u32_locale_tocase ((scm_t_uint32 *) buf, 1, &downbuf,
                          &downlen, u32_tolower);
 
   if (SCM_UNLIKELY (ret != 0))
@@ -1136,7 +1181,7 @@ SCM_DEFINE (scm_char_locale_downcase, 
"char-locale-downcase", 1, 1, 0,
     }
 
   if (downlen == 1)
-    downchar = SCM_MAKE_CHAR (downbuf[0]);
+    downchar = SCM_MAKE_CHAR ((scm_t_wchar) downbuf[0]);
   else
     downchar = chr;
   free (downbuf);
@@ -1153,7 +1198,8 @@ SCM_DEFINE (scm_char_locale_upcase, "char-locale-upcase", 
1, 1, 0,
 {
   int ret;
   scm_t_locale c_locale;
-  scm_t_wchar *buf, *upbuf;
+  scm_t_wchar *buf;
+  scm_t_uint32 *upbuf;
   size_t uplen;
   SCM str, upchar;
 
@@ -1166,11 +1212,11 @@ SCM_DEFINE (scm_char_locale_upcase, 
"char-locale-upcase", 1, 1, 0,
   if (c_locale != NULL)
     RUN_IN_LOCALE_SECTION (c_locale, ret =
                            u32_locale_tocase ((scm_t_uint32 *) buf, 1,
-                                              (scm_t_uint32 **) &upbuf,
+                                              &upbuf,
                                               &uplen, u32_toupper));
   else
     ret =
-      u32_locale_tocase ((scm_t_uint32 *) buf, 1, (scm_t_uint32 **) &upbuf,
+      u32_locale_tocase ((scm_t_uint32 *) buf, 1, &upbuf,
                          &uplen, u32_toupper);
 
   if (SCM_UNLIKELY (ret != 0))
@@ -1179,7 +1225,7 @@ SCM_DEFINE (scm_char_locale_upcase, "char-locale-upcase", 
1, 1, 0,
       scm_syserror (FUNC_NAME);
     }
   if (uplen == 1)
-    upchar = SCM_MAKE_CHAR (upbuf[0]);
+    upchar = SCM_MAKE_CHAR ((scm_t_wchar) upbuf[0]);
   else
     upchar = chr;
   free (upbuf);
@@ -1194,7 +1240,8 @@ SCM_DEFINE (scm_string_locale_upcase, 
"string-locale-upcase", 1, 1, 0,
            "locale.")
 #define FUNC_NAME s_scm_string_locale_upcase
 {
-  scm_t_wchar *c_str, *c_upstr, *c_buf;
+  scm_t_wchar *c_str, *c_buf;
+  scm_t_uint32 *c_upstr;
   size_t len, uplen;
   int ret;
   scm_t_locale c_locale;
@@ -1210,12 +1257,12 @@ SCM_DEFINE (scm_string_locale_upcase, 
"string-locale-upcase", 1, 1, 0,
   if (c_locale)
     RUN_IN_LOCALE_SECTION (c_locale, ret =
                            u32_locale_tocase ((scm_t_uint32 *) c_str, len,
-                                              (scm_t_uint32 **) &c_upstr,
+                                              &c_upstr,
                                               &uplen, u32_toupper));
   else
     ret =
       u32_locale_tocase ((scm_t_uint32 *) c_str, len,
-                         (scm_t_uint32 **) &c_upstr, &uplen, u32_toupper);
+                         &c_upstr, &uplen, u32_toupper);
 
   scm_remember_upto_here (str);
 
@@ -1242,7 +1289,8 @@ SCM_DEFINE (scm_string_locale_downcase, 
"string-locale-downcase", 1, 1, 0,
            "locale.")
 #define FUNC_NAME s_scm_string_locale_downcase
 {
-  scm_t_wchar *c_str, *c_downstr, *c_buf;
+  scm_t_wchar *c_str, *c_buf;
+  scm_t_uint32 *c_downstr;
   size_t len, downlen;
   int ret;
   scm_t_locale c_locale;
@@ -1258,12 +1306,12 @@ SCM_DEFINE (scm_string_locale_downcase, 
"string-locale-downcase", 1, 1, 0,
   if (c_locale)
     RUN_IN_LOCALE_SECTION (c_locale, ret =
                            u32_locale_tocase ((scm_t_uint32 *) c_str, len,
-                                              (scm_t_uint32 **) &c_downstr,
+                                              &c_downstr,
                                               &downlen, u32_tolower));
   else
     ret =
       u32_locale_tocase ((scm_t_uint32 *) c_str, len,
-                         (scm_t_uint32 **) &c_downstr, &downlen, u32_tolower);
+                         &c_downstr, &downlen, u32_tolower);
 
   scm_remember_upto_here (str);
 
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index 6bfdbc7..4f11a8a 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -85,6 +85,9 @@
 (define %french-utf8-locale-name
   "fr_FR.UTF-8")
 
+(define %turkish-utf8-locale-name
+  "tr_TR.UTF-8")
+
 (define %french-locale
   (false-if-exception
    (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
@@ -95,6 +98,11 @@
    (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
                 %french-utf8-locale-name)))
 
+(define %turkish-utf8-locale
+  (false-if-exception
+   (make-locale LC_ALL
+                %turkish-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
@@ -113,6 +121,8 @@
 (define (under-french-utf8-locale-or-unresolved thunk)
   (under-locale-or-unresolved %french-utf8-locale thunk))
 
+(define (under-turkish-utf8-locale-or-unresolved thunk)
+  (under-locale-or-unresolved %turkish-utf8-locale thunk))
 
 (with-test-prefix "text collation (French)"
 
@@ -190,7 +200,38 @@
 
   (pass-if "char-locale-upcase"
     (and (eq? #\Z (char-locale-upcase #\z))
-         (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C"))))))
+         (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
+
+  (pass-if "char-locale-upcase Turkish"
+    (under-turkish-utf8-locale-or-unresolved
+     (lambda ()
+       (eq? #\Ä° (char-locale-upcase #\i %turkish-utf8-locale)))))
+
+  (pass-if "char-locale-downcase Turkish"
+    (under-turkish-utf8-locale-or-unresolved
+     (lambda ()
+       (eq? #\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-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"


hooks/post-receive
-- 
GNU Guile