guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-12-gc54


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-3-12-gc543e41
Date: Fri, 18 Sep 2009 11:02:27 +0000

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=c543e41eb4e1437d3f994b6b8d54540b33145aa7

The branch, master has been updated
       via  c543e41eb4e1437d3f994b6b8d54540b33145aa7 (commit)
       via  cdf52ff02071055387eaa37e92a3a603abcf0f61 (commit)
       via  df047aa2b11ccffaa93a523de517fe0c14cecd4c (commit)
       via  12f0c3e547810cfe8db669904623a1207b77a67e (commit)
       via  d7a22073268779fd37a8ef8e69816076f63615d8 (commit)
      from  5b87844575ff7e8071d0fd9f10c9212a4f6afd16 (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 c543e41eb4e1437d3f994b6b8d54540b33145aa7
Author: Ludovic Courtès <address@hidden>
Date:   Fri Sep 18 12:58:54 2009 +0200

    i18n: Remove non-local exists from `u32_locale_casecoll ()'.
    
    * libguile/i18n.c (u32_locale_casecoll): Add RESULT argument.  Return
      zero or ERRNO.
      (compare_u32_strings_ci): Adjust accordingly.

commit cdf52ff02071055387eaa37e92a3a603abcf0f61
Author: Ludovic Courtès <address@hidden>
Date:   Fri Sep 18 12:32:09 2009 +0200

    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.

commit df047aa2b11ccffaa93a523de517fe0c14cecd4c
Author: Ludovic Courtès <address@hidden>
Date:   Fri Sep 18 12:21:22 2009 +0200

    i18n: Avoid needless heap allocation.
    
    * libguile/i18n.c (SCM_STRING_TO_U32_BUF): Allocate buffers on the stack
      rather on the heap.
      (SCM_U32_BUF_FREE): Remove.  Callers updated.

commit 12f0c3e547810cfe8db669904623a1207b77a67e
Author: Ludovic Courtès <address@hidden>
Date:   Fri Sep 18 12:15:26 2009 +0200

    i18n: Simplify `RUN_IN_LOCALE_SECTION' (GNU version).
    
    * libguile/i18n.c (RUN_IN_LOCALE_SECTION)[USE_GNU_LOCALE_API]: Remove
      extraneous uselocale(3) call.

commit d7a22073268779fd37a8ef8e69816076f63615d8
Author: Ludovic Courtès <address@hidden>
Date:   Fri Sep 18 11:40:03 2009 +0200

    Add the `%host-type' global variable.
    
    * configure.ac: Define `HOST_TYPE'.
    
    * libguile/load.c (sys_host_type): New variable.
    
    * doc/ref/api-options.texi (Build Config): Document `%host-type'.

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

Summary of changes:
 configure.ac               |    3 +
 doc/ref/api-options.texi   |   10 +++-
 libguile/i18n.c            |  127 ++++++++++++++++++++------------------------
 libguile/load.c            |    4 ++
 test-suite/tests/i18n.test |   91 ++++++++++++++++++++++++-------
 5 files changed, 143 insertions(+), 92 deletions(-)

diff --git a/configure.ac b/configure.ac
index 589c798..8c791ca 100644
--- a/configure.ac
+++ b/configure.ac
@@ -86,6 +86,9 @@ AM_CONDITIONAL(HAVE_MAKEINFO, test "$have_makeinfo" = yes)
 
 AM_PATH_LISPDIR
 
+AC_DEFINE_UNQUOTED([HOST_TYPE], ["$host"],
+  [Define to the host's GNU triplet.])
+
 #--------------------------------------------------------------------
 #
 # User options (after above tests that may set default CFLAGS etc.)
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index f7d0962..f4caa8a 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2006, 2008
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 
2006, 2008, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -178,6 +178,14 @@ libguile/libpath.h, which is completely generated, so 
deleting this file
 before a build guarantees up-to-date values for that build.
 @end defvar
 
address@hidden GNU triplet
address@hidden canonical host type
+
address@hidden %host-type
+The canonical host type (GNU triplet) of the host Guile was configured
+for, e.g., @code{"x86_64-unknown-linux-gnu"} (@pxref{Canonicalizing,,,
+autoconf, The GNU Autoconf Manual}).
address@hidden defvar
 
 @node Feature Tracking
 @subsection Feature Tracking
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 28dfe4d..511184c 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -509,19 +509,15 @@ get_current_locale (SCM *result)
 #else /* USE_GNU_LOCALE_API */
 
 /* Convenient macro to run STATEMENT in the locale context of C_LOCALE.  */
-#define RUN_IN_LOCALE_SECTION(_c_locale, _statement)                    \
-  do                                                                    \
-    {                                                                   \
-      scm_t_locale old_loc = uselocale (NULL);                          \
-      if (old_loc != _c_locale)                                         \
-        {                                                               \
-          uselocale (_c_locale);                                        \
-          _statement ;                                                  \
-          uselocale (old_loc);                                          \
-        }                                                               \
-      else                                                              \
-        _statement;                                                     \
-    }                                                                   \
+#define RUN_IN_LOCALE_SECTION(_c_locale, _statement)   \
+  do                                                   \
+    {                                                  \
+      scm_t_locale old_loc;                            \
+                                                       \
+      old_loc = uselocale (_c_locale);                 \
+      _statement ;                                     \
+      uselocale (old_loc);                             \
+    }                                                  \
   while (0)
 
 
@@ -730,32 +726,29 @@ SCM_DEFINE (scm_locale_p, "locale?", 1, 0, 0,
    A similar API can be found in MzScheme starting from version 200:
    http://download.plt-scheme.org/chronology/mzmr200alpha14.html .  */
 
-#define SCM_STRING_TO_U32_BUF(s1, c_s1)                                 \
-  do {                                                                  \
-    if (scm_i_is_narrow_string (s1))                                    \
-      {                                                                 \
-        size_t i, len;                                                  \
-        const char *buf = scm_i_string_chars (s1);                      \
-        len = scm_i_string_length (s1);                                 \
-        c_s1 = (scm_t_wchar *) scm_malloc (sizeof (scm_t_wchar) * (len + 1)); \
-        for (i = 0; i < len; i ++)                                      \
-          c_s1[i] = (unsigned char ) buf[i];                            \
-        c_s1[len] = 0;                                                  \
-      }                                                                 \
-    else                                                                \
-      c_s1 = (scm_t_wchar *) scm_i_string_wide_chars (s1);              \
-  } while (0)
-
-#define SCM_U32_BUF_FREE(s1, c_s1)              \
-  do {                                          \
-    if (scm_i_is_narrow_string (s1))            \
-      free (c_s1);                              \
-  } while (0)
-
-
-/* Compare u32 strings according to the LOCALE.  Returns a negative
-     value if S1 compares smaller than S2, a positive value if S1
-     compares larger than S2, or 0 if they compare equal.  */
+#define SCM_STRING_TO_U32_BUF(s1, c_s1)                                        
\
+  do                                                                   \
+    {                                                                  \
+      if (scm_i_is_narrow_string (s1))                                 \
+       {                                                               \
+         size_t i, len;                                                \
+         const char *buf = scm_i_string_chars (s1);                    \
+                                                                       \
+         len = scm_i_string_length (s1);                               \
+         c_s1 = (scm_t_wchar *) alloca (sizeof (scm_t_wchar) * (len + 1)); \
+                                                                       \
+         for (i = 0; i < len; i ++)                                    \
+           c_s1[i] = (unsigned char ) buf[i];                          \
+         c_s1[len] = 0;                                                \
+       }                                                               \
+      else                                                             \
+       c_s1 = (scm_t_wchar *) scm_i_string_wide_chars (s1);            \
+    } while (0)
+
+
+/* Compare UTF-32 strings according to LOCALE.  Returns a negative value if
+   S1 compares smaller than S2, a positive value if S1 compares larger than
+   S2, or 0 if they compare equal.  */
 static inline int
 compare_u32_strings (SCM s1, SCM s2, SCM locale, const char *func_name) 
 #define FUNC_NAME func_name
@@ -773,11 +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);
-
-  SCM_U32_BUF_FREE (s1, c_s1);
-  SCM_U32_BUF_FREE (s2, 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);
@@ -787,26 +777,27 @@ compare_u32_strings (SCM s1, SCM s2, SCM locale, const 
char *func_name)
 
 static inline int
 u32_locale_casecoll (const char *func_name, const scm_t_uint32 *c_s1, 
-                     const scm_t_uint32 *c_s2)
+                     const scm_t_uint32 *c_s2,
+                    int *result)
 {
-  int result, ret;
-  const char *loc = uc_locale_language ();
+  /* Note: Since this is called from `RUN_IN_LOCALE_SECTION', it must note
+     make any non-local exit.  */
 
+  int ret;
+  const char *loc = uc_locale_language ();
 
   ret = u32_casecoll (c_s1, u32_strlen (c_s1), 
                       c_s2, u32_strlen (c_s2),
-                      loc, UNINORM_NFC, &result);
-  if (ret != 0)
-    scm_syserror (func_name);
+                      loc, UNINORM_NFC, result);
 
-  return result;
+  return ret == 0 ? ret : errno;
 }
 
 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, ret = 0;
   scm_t_locale c_locale;
   scm_t_wchar *c_s1, *c_s2;
   SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
@@ -815,27 +806,23 @@ 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,
+       ret = u32_locale_casecoll (func_name,
+                                 (const scm_t_uint32 *) c_s1,
+                                 (const scm_t_uint32 *) c_s2,
+                                 &result));
   else
+    ret = u32_locale_casecoll (func_name,
+                              (const scm_t_uint32 *) c_s1,
+                              (const scm_t_uint32 *) c_s2,
+                              &result);
+
+  if (SCM_UNLIKELY (ret != 0))
     {
-      /* 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);
+      errno = ret;
+      scm_syserror (FUNC_NAME);
     }
-  
-  SCM_U32_BUF_FREE (s1, c_s1);
-  SCM_U32_BUF_FREE (s2, c_s2);
 
   scm_remember_upto_here_2 (s1, s2);
   scm_remember_upto_here (locale);
diff --git a/libguile/load.c b/libguile/load.c
index f2c06f0..246cf89 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -778,6 +778,10 @@ scm_c_primitive_load_path (const char *filename)
 
 /* Information about the build environment.  */
 
+SCM_VARIABLE_INIT (sys_host_type, "%host-type",
+                  scm_from_locale_string (HOST_TYPE));
+
+
 /* Initialize the scheme variable %guile-build-info, based on data
    provided by the Makefile, via libpath.h.  */
 static void
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index c4777c2..6bfdbc7 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 ()
-        (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:


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]