Use Gnulib's `duplocale' module.

* libguile/i18n.c (scm_make_locale): Simplify global locale handling,
  using duplocale(3) for all kinds of locales.
  (scm_init_i18n): Comment on why we don't just use `LC_GLOBAL_LOCALE'
  for `global_locale_smob'.

* m4/gnulib-cache.m4: Add `duplocale'.

lib/Makefile.am

@@ -9,7 +9,7 @@
 # the same distribution terms as the rest of that program.
 #
 # Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files alignof alloca-opt announce-gen autobuild byteswap canonicalize-lgpl environ extensions flock fpieee full-read full-write gendocs gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton lib-symbol-versions lib-symbol-visibility libunistring locale maintainer-makefile putenv stdlib strcase strftime striconveh string verify version-etc-fsf vsnprintf warnings
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files alignof alloca-opt announce-gen autobuild byteswap canonicalize-lgpl duplocale environ extensions flock fpieee full-read full-write gendocs gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton lib-symbol-versions lib-symbol-visibility libunistring locale maintainer-makefile putenv stdlib strcase strftime striconveh string verify version-etc-fsf vsnprintf warnings
 
 AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
 
@@ -205,6 +205,15 @@ CLEANFILES += configmake.h configmake.h-t
 
 ## end   gnulib module configmake
 
+## begin gnulib module duplocale
+
+
+EXTRA_DIST += duplocale.c
+
+EXTRA_libgnu_la_SOURCES += duplocale.c
+
+## end   gnulib module duplocale
+
 ## begin gnulib module errno
 
 BUILT_SOURCES += $(ERRNO_H)

lib/duplocale.c

@@ -0,0 +1,115 @@
+/* Duplicate a locale object.
+   Copyright (C) 2009 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* Written by Bruno Haible <bruno@clisp.org>, 2007.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <locale.h>
+
+#include <errno.h>
+#include <langinfo.h>
+#include <string.h>
+
+/* Work around an incorrect definition of the _NL_LOCALE_NAME macro in
+   glibc < 2.12.
+   See <http://sourceware.org/bugzilla/show_bug.cgi?id=10968>.  */
+#undef _NL_LOCALE_NAME
+#define _NL_LOCALE_NAME(category) _NL_ITEM ((category), _NL_ITEM_INDEX (-1))
+
+#define SIZEOF(a) (sizeof(a) / sizeof(a[0]))
+
+#undef duplocale
+
+locale_t
+rpl_duplocale (locale_t locale)
+{
+  /* Work around crash in the duplocale function in glibc < 2.12.
+     See <http://sourceware.org/bugzilla/show_bug.cgi?id=10969>.  */
+  if (locale == LC_GLOBAL_LOCALE)
+    {
+      /* Create a copy of the locale by fetching the name of each locale
+	 category, starting with LC_CTYPE.  */
+      static struct { int cat; int mask; } categories[] =
+	{
+	    { LC_NUMERIC,        LC_NUMERIC_MASK },
+	    { LC_TIME,           LC_TIME_MASK },
+	    { LC_COLLATE,        LC_COLLATE_MASK },
+	    { LC_MONETARY,       LC_MONETARY_MASK },
+	    { LC_MESSAGES,       LC_MESSAGES_MASK }
+#ifdef LC_PAPER
+	  , { LC_PAPER,          LC_PAPER_MASK }
+#endif
+#ifdef LC_NAME
+	  , { LC_NAME,           LC_NAME_MASK }
+#endif
+#ifdef LC_ADDRESS
+	  , { LC_ADDRESS,        LC_ADDRESS_MASK }
+#endif
+#ifdef LC_TELEPHONE
+	  , { LC_TELEPHONE,      LC_TELEPHONE_MASK }
+#endif
+#ifdef LC_MEASUREMENT
+	  , { LC_MEASUREMENT,    LC_MEASUREMENT_MASK }
+#endif
+#ifdef LC_IDENTIFICATION
+	  , { LC_IDENTIFICATION, LC_IDENTIFICATION_MASK }
+#endif
+	};
+      const char *base_name;
+      locale_t base_copy;
+      unsigned int i;
+
+      base_name = nl_langinfo (_NL_LOCALE_NAME (LC_CTYPE));
+      if (base_name[0] == '\0')
+	/* Fallback code for glibc < 2.4, which did not implement
+	   nl_langinfo (_NL_LOCALE_NAME (category)).  */
+	base_name = setlocale (LC_CTYPE, NULL);
+      base_copy = newlocale (LC_ALL_MASK, base_name, NULL);
+      if (base_copy == NULL)
+	return NULL;
+
+      for (i = 0; i < SIZEOF (categories); i++)
+	{
+	  int category = categories[i].cat;
+	  int category_mask = categories[i].mask;
+	  const char *name = nl_langinfo (_NL_LOCALE_NAME (category));
+	  if (name[0] == '\0')
+	    /* Fallback code for glibc < 2.4, which did not implement
+	       nl_langinfo (_NL_LOCALE_NAME (category)).  */
+	    name = setlocale (category, NULL);
+	  if (strcmp (name, base_name) != 0)
+	    {
+	      locale_t copy = newlocale (category_mask, name, base_copy);
+	      if (copy == NULL)
+		{
+		  int saved_errno = errno;
+		  freelocale (base_copy);
+		  errno = saved_errno;
+		  return NULL;
+		}
+	      /* No need to call freelocale (base_copy) if copy != base_copy;
+		 the newlocale function already takes care of doing it.  */
+	      base_copy = copy;
+	    }
+	}
+
+      return base_copy;
+    }
+
+  return duplocale (locale);
+}

libguile/i18n.c

@@ -614,27 +614,14 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
 #ifdef USE_GNU_LOCALE_API
 
   if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale)))
-    {
+    c_base_locale = LC_GLOBAL_LOCALE;
-      /* Fetch the current locale and turn in into a `locale_t'.  Don't
-	 duplicate the resulting `locale_t' because we want it to be consumed
-	 by `newlocale ()'.  */
-      char *current_locale;
 
-      scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+  if (c_base_locale != (locale_t) 0)
-
-      current_locale = setlocale (LC_ALL, NULL);
-      c_base_locale = newlocale (LC_ALL_MASK, current_locale, NULL);
-
-      scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
-
-      if (c_base_locale == (locale_t) 0)
-	scm_locale_error (FUNC_NAME, errno);
-    }
-  else if (c_base_locale != (locale_t) 0)
     {
       /* C_BASE_LOCALE is to be consumed by `newlocale ()' so it needs to be
 	 duplicated before.  */
       c_base_locale = duplocale (c_base_locale);
+
       if (c_base_locale == (locale_t) 0)
 	{
 	  err = errno;
@@ -648,10 +635,8 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
 
   if (c_locale == (locale_t) 0)
     {
-      if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale)))
+      if (c_base_locale != (locale_t) 0)
-	/* The base locale object was created lazily and must be freed.  */
 	freelocale (c_base_locale);
-
       scm_locale_error (FUNC_NAME, errno);
     }
   else
@@ -1812,6 +1797,9 @@ scm_init_i18n ()
 #include "libguile/i18n.x"
 
   /* Initialize the global locale object with a special `locale' SMOB.  */
+  /* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
+     glibc <= 2.11 not (yet) worked around by Gnulib.  See
+     http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details.  */
   SCM_NEWSMOB (global_locale_smob, scm_tc16_locale_smob_type, NULL);
   SCM_VARIABLE_SET (scm_global_locale, global_locale_smob);
 }

m4/duplocale.m4

@@ -0,0 +1,56 @@
+# duplocale.m4 serial 1
+dnl Copyright (C) 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_DUPLOCALE],
+[
+  AC_REQUIRE([gl_LOCALE_H_DEFAULTS])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  AC_CHECK_FUNCS_ONCE([duplocale])
+  if test $ac_cv_func_duplocale = yes; then
+    dnl Check against glibc bug where duplocale crashes.
+    dnl See <http://sourceware.org/bugzilla/show_bug.cgi?id=10969>.
+    AC_REQUIRE([gl_LOCALE_H])
+    AC_CACHE_CHECK([whether duplocale(LC_GLOBAL_LOCALE) works],
+      [gl_cv_func_duplocale_works],
+      [AC_TRY_RUN([
+#include <locale.h>
+#if HAVE_XLOCALE_H
+# include <xlocale.h>
+#endif
+int main ()
+{
+  (void) duplocale (LC_GLOBAL_LOCALE);
+  return 0;
+}], [gl_cv_func_duplocale_works=yes], [gl_cv_func_duplocale_works=no],
+         [dnl Guess it works except on glibc < 2.12.
+          AC_EGREP_CPP([Unlucky GNU user], [
+#include <features.h>
+#ifdef __GNU_LIBRARY__
+ #if (__GLIBC__ == 2 && __GLIBC_MINOR__ < 12)
+  Unlucky GNU user
+ #endif
+#endif
+            ],
+            [gl_cv_func_duplocale_works="guessing no"],
+            [gl_cv_func_duplocale_works="guessing yes"])
+         ])
+      ])
+    case "$gl_cv_func_duplocale_works" in
+      *no) REPLACE_DUPLOCALE=1 ;;
+    esac
+  fi
+  if test $REPLACE_DUPLOCALE = 1; then
+    gl_REPLACE_LOCALE_H
+    AC_LIBOBJ([duplocale])
+    gl_PREREQ_DUPLOCALE
+  fi
+])
+
+# Prerequisites of lib/duplocale.c.
+AC_DEFUN([gl_PREREQ_DUPLOCALE],
+[
+  :
+])

m4/gnulib-cache.m4

@@ -15,7 +15,7 @@
 
 
 # Specification in the form of a command-line invocation:
-#   gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files alignof alloca-opt announce-gen autobuild byteswap canonicalize-lgpl environ extensions flock fpieee full-read full-write gendocs gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton lib-symbol-versions lib-symbol-visibility libunistring locale maintainer-makefile putenv stdlib strcase strftime striconveh string verify version-etc-fsf vsnprintf warnings
+#   gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl=3 --libtool --macro-prefix=gl --no-vc-files alignof alloca-opt announce-gen autobuild byteswap canonicalize-lgpl duplocale environ extensions flock fpieee full-read full-write gendocs gitlog-to-changelog gnu-web-doc-update gnupload havelib iconv_open-utf inet_ntop inet_pton lib-symbol-versions lib-symbol-visibility libunistring locale maintainer-makefile putenv stdlib strcase strftime striconveh string verify version-etc-fsf vsnprintf warnings
 
 # Specification in the form of a few gnulib-tool.m4 macro invocations:
 gl_LOCAL_DIR([])
@@ -26,6 +26,7 @@ gl_MODULES([
   autobuild
   byteswap
   canonicalize-lgpl
+  duplocale
   environ
   extensions
   flock

m4/gnulib-comp.m4

@@ -57,6 +57,8 @@ AC_DEFUN([gl_INIT],
   gl_MODULE_INDICATOR([canonicalize-lgpl])
   gl_STDLIB_MODULE_INDICATOR([canonicalize_file_name])
   gl_STDLIB_MODULE_INDICATOR([realpath])
+  gl_FUNC_DUPLOCALE
+  gl_LOCALE_MODULE_INDICATOR([duplocale])
   gl_ENVIRON
   gl_UNISTD_MODULE_INDICATOR([environ])
   gl_HEADER_ERRNO_H
@@ -306,6 +308,7 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/c-strncasecmp.c
   lib/canonicalize-lgpl.c
   lib/config.charset
+  lib/duplocale.c
   lib/errno.in.h
   lib/float+.h
   lib/float.in.h
@@ -407,6 +410,7 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/codeset.m4
   m4/dos.m4
   m4/double-slash-root.m4
+  m4/duplocale.m4
   m4/eealloc.m4
   m4/environ.m4
   m4/errno_h.m4