mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-04 00:30:30 +02:00
Code Activity

Simplify i18n.c to require POSIX 2008 newlocale, uselocale

Browse source 
* libguile/i18n.c: Remove shim for pre-POSIX 2008, given that gnulib
does appear to have newlocale/uselocale implementations.
* libguile/posix.c: No USE_GNU_LOCALE_API define.
* libguile/r6rs-ports.c: Remove stray include.
This commit is contained in:
Andy Wingo 2025-06-18 12:02:41 +02:00
parent 3f4048f6c8
commit a5c70aa914
3 changed files with 29 additions and 460 deletions
Download patch file Download diff file Expand all files Collapse all files

478
libguile/i18n.c
View file

@ -55,21 +55,8 @@
# define SCM_MAX_ALLOCA 4096 /* Max bytes per string to allocate via alloca */
#endif
#if defined HAVE_NEWLOCALE && defined HAVE_STRCOLL_L && defined HAVE_USELOCALE
/* The GNU thread-aware locale API is documented in ``Thread-Aware Locale
Model, a Proposal'', by Ulrich Drepper:
http://people.redhat.com/drepper/tllocale.ps.gz
It is now also implemented by Darwin:
http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/newlocale.3.html
The whole API was eventually standardized in the ``Open Group Base
Specifications Issue 7'' (aka. "POSIX 2008"):
http://www.opengroup.org/onlinepubs/9699919799/basedefs/locale.h.html */
# define USE_GNU_LOCALE_API
#if !defined HAVE_NEWLOCALE || !defined HAVE_USELOCALE
#warning POSIX 2008 locale API (newlocale, uselocale) seems to be missing
#endif
/* Use Gnulib's header, which also provides `nl_item' & co. */
@ -127,21 +114,6 @@ unlock_locale_mutex (void)
/* Locale objects, string and character collation, and other locale-dependent
string operations.
A large part of the code here deals with emulating glibc's reentrant
locale API on non-GNU systems. The emulation is a bit "brute-force":
Whenever a `-locale<?' procedure is passed a locale object, then:
1. The `scm_i_locale_mutex' is locked.
2. A series of `setlocale ()' call is performed to store the current
locale for each category in an `scm_t_locale' object.
3. A series of `setlocale ()' call is made to install each of the locale
categories of each of the base locales of each locale object,
recursively, starting from the last locale object of the chain.
4. The settings captured in step (2) are restored.
5. The `scm_i_locale_mutex' is released.
Hopefully, the X/Open standard will eventually make this hack useless.
Note: We don't wrap glibc's `uselocale ()' call because it sets the locale
of the current _thread_ (unlike `setlocale ()') and doing so would require
maintaining per-thread locale information on non-GNU systems and always
@ -151,79 +123,9 @@ unlock_locale_mutex (void)
/* Return the category mask corresponding to CAT. */
#define SCM_LOCALE_CATEGORY_MASK(_cat) LC_ ## _cat ## _MASK
#ifndef USE_GNU_LOCALE_API
/* Provide the locale category masks as found in glibc. This must be kept in
sync with `locale-categories.h'. */
# define LC_CTYPE_MASK 1
# define LC_COLLATE_MASK 2
# define LC_MESSAGES_MASK 4
# define LC_MONETARY_MASK 8
# define LC_NUMERIC_MASK 16
# define LC_TIME_MASK 32
# ifdef LC_PAPER
# define LC_PAPER_MASK 64
# else
# define LC_PAPER_MASK 0
# endif
# ifdef LC_NAME
# define LC_NAME_MASK 128
# else
# define LC_NAME_MASK 0
# endif
# ifdef LC_ADDRESS
# define LC_ADDRESS_MASK 256
# else
# define LC_ADDRESS_MASK 0
# endif
# ifdef LC_TELEPHONE
# define LC_TELEPHONE_MASK 512
# else
# define LC_TELEPHONE_MASK 0
# endif
# ifdef LC_MEASUREMENT
# define LC_MEASUREMENT_MASK 1024
# else
# define LC_MEASUREMENT_MASK 0
# endif
# ifdef LC_IDENTIFICATION
# define LC_IDENTIFICATION_MASK 2048
# else
# define LC_IDENTIFICATION_MASK 0
# endif
# define LC_ALL_MASK (LC_CTYPE_MASK \
| LC_NUMERIC_MASK \
| LC_TIME_MASK \
| LC_COLLATE_MASK \
| LC_MONETARY_MASK \
| LC_MESSAGES_MASK \
| LC_PAPER_MASK \
| LC_NAME_MASK \
| LC_ADDRESS_MASK \
| LC_TELEPHONE_MASK \
| LC_MEASUREMENT_MASK \
| LC_IDENTIFICATION_MASK \
)
/* Locale objects as returned by `make-locale' on non-GNU systems. */
typedef struct scm_locale
{
SCM base_locale; /* a `locale' object */
char *locale_name;
int category_mask;
} *scm_t_locale;
#else /* USE_GNU_LOCALE_API */
/* Alias for glibc's locale type. */
typedef locale_t scm_t_locale;
#endif /* USE_GNU_LOCALE_API */
/* A locale object denoting the global locale. */
SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
@ -235,7 +137,7 @@ SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
do \
{ \
SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type); \
(_c_locale) = (scm_t_locale)SCM_SMOB_DATA (_arg); \
(_c_locale) = (locale_t)SCM_SMOB_DATA (_arg); \
} \
while (0)
@ -254,21 +156,17 @@ SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
SCM_SMOB (scm_tc16_locale_smob_type, "locale", 0);
#ifdef USE_GNU_LOCALE_API
SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale)
{
scm_t_locale c_locale;
locale_t c_locale;
c_locale = (scm_t_locale) SCM_SMOB_DATA (locale);
c_locale = (locale_t) SCM_SMOB_DATA (locale);
if (c_locale)
freelocale (c_locale);
return 0;
}
#endif /* USE_GNU_LOCALE_API */
static void inline scm_locale_error (const char *, int) SCM_NORETURN;
@ -283,267 +181,12 @@ scm_locale_error (const char *func_name, int err)
/* Emulating GNU's reentrant locale API. */
#ifndef USE_GNU_LOCALE_API
/* Maximum number of chained locales (via `base_locale'). */
#define LOCALE_STACK_SIZE_MAX 256
typedef struct
{
#define SCM_DEFINE_LOCALE_CATEGORY(_name) char * _name;
#include "locale-categories.h"
#undef SCM_DEFINE_LOCALE_CATEGORY
} scm_t_locale_settings;
/* Fill out SETTINGS according to the current locale settings. On success
zero is returned and SETTINGS is properly initialized. */
static int
get_current_locale_settings (scm_t_locale_settings *settings)
{
const char *locale_name;
#define SCM_DEFINE_LOCALE_CATEGORY(_name) \
{ \
SCM_SYSCALL (locale_name = setlocale (LC_ ## _name, NULL)); \
if (locale_name == NULL) \
goto handle_error; \
\
settings-> _name = strdup (locale_name); \
if (settings-> _name == NULL) \
goto handle_oom; \
}
#include "locale-categories.h"
#undef SCM_DEFINE_LOCALE_CATEGORY
return 0;
handle_error:
return EINVAL;
handle_oom:
return ENOMEM;
}
/* Restore locale settings SETTINGS. On success, return zero. */
static int
restore_locale_settings (const scm_t_locale_settings *settings)
{
const char *result;
#define SCM_DEFINE_LOCALE_CATEGORY(_name) \
SCM_SYSCALL (result = setlocale (LC_ ## _name, settings-> _name)); \
if (result == NULL) \
goto handle_error;
#include "locale-categories.h"
#undef SCM_DEFINE_LOCALE_CATEGORY
return 0;
handle_error:
return EINVAL;
}
/* Free memory associated with SETTINGS. */
static void
free_locale_settings (scm_t_locale_settings *settings)
{
#define SCM_DEFINE_LOCALE_CATEGORY(_name) \
free (settings-> _name); \
settings->_name = NULL;
#include "locale-categories.h"
#undef SCM_DEFINE_LOCALE_CATEGORY
}
/* Install the locale named LOCALE_NAME for all the categories listed in
CATEGORY_MASK. */
static int
install_locale_categories (const char *locale_name, int category_mask)
{
const char *result;
if (category_mask == LC_ALL_MASK)
{
SCM_SYSCALL (result = setlocale (LC_ALL, locale_name));
if (result == NULL)
goto handle_error;
}
else
{
#define SCM_DEFINE_LOCALE_CATEGORY(_name) \
if (category_mask & SCM_LOCALE_CATEGORY_MASK (_name)) \
{ \
SCM_SYSCALL (result = setlocale (LC_ ## _name, locale_name)); \
if (result == NULL) \
goto handle_error; \
}
#include "locale-categories.h"
#undef SCM_DEFINE_LOCALE_CATEGORY
}
return 0;
handle_error:
return EINVAL;
}
/* Install LOCALE, recursively installing its base locales first. On
success, zero is returned. */
static int
install_locale (scm_t_locale locale)
{
scm_t_locale stack[LOCALE_STACK_SIZE_MAX];
int category_mask = 0;
size_t stack_size = 0;
int stack_offset = 0;
const char *result = NULL;
/* Build up a locale stack by traversing the `base_locale' link. */
do
{
if (stack_size >= LOCALE_STACK_SIZE_MAX)
/* We cannot use `scm_error ()' here because otherwise the locale
mutex may remain locked. */
return EINVAL;
stack[stack_size++] = locale;
/* Keep track of which categories have already been taken into
account. */
category_mask |= locale->category_mask;
if (!SCM_UNBNDP (locale->base_locale))
locale = (scm_t_locale) SCM_SMOB_DATA (locale->base_locale);
else
locale = NULL;
}
while ((locale != NULL) && (category_mask != LC_ALL_MASK));
/* Install the C locale to start from a pristine state. */
SCM_SYSCALL (result = setlocale (LC_ALL, "C"));
if (result == NULL)
goto handle_error;
/* Install the locales in reverse order. */
for (stack_offset = stack_size - 1;
stack_offset >= 0;
stack_offset--)
{
int err;
scm_t_locale locale;
locale = stack[stack_offset];
err = install_locale_categories (locale->locale_name,
locale->category_mask);
if (err)
goto handle_error;
}
return 0;
handle_error:
return EINVAL;
}
/* Leave the locked locale section. */
static inline void
leave_locale_section (const scm_t_locale_settings *settings)
{
/* Restore the previous locale settings. */
(void)restore_locale_settings (settings);
unlock_locale_mutex ();
}
/* Enter a locked locale section. */
static inline int
enter_locale_section (scm_t_locale locale,
scm_t_locale_settings *prev_locale)
{
int err;
lock_locale_mutex ();
err = get_current_locale_settings (prev_locale);
if (err)
{
unlock_locale_mutex ();
return err;
}
err = install_locale (locale);
if (err)
{
leave_locale_section (prev_locale);
free_locale_settings (prev_locale);
}
return err;
}
/* Convenient macro to run STATEMENT in the locale context of C_LOCALE. */
#define RUN_IN_LOCALE_SECTION(_c_locale, _statement) \
do \
{ \
int lsec_err; \
scm_t_locale_settings lsec_prev_locale; \
\
lsec_err = enter_locale_section ((_c_locale), &lsec_prev_locale); \
if (lsec_err) \
scm_locale_error (FUNC_NAME, lsec_err); \
else \
{ \
_statement ; \
\
leave_locale_section (&lsec_prev_locale); \
free_locale_settings (&lsec_prev_locale); \
} \
} \
while (0)
/* Convert the current locale settings into a locale SMOB. On success, zero
is returned and RESULT points to the new SMOB. Otherwise, an error is
returned. */
static int
get_current_locale (SCM *result)
{
int err = 0;
scm_t_locale c_locale;
const char *current_locale;
c_locale = scm_gc_malloc (sizeof (* c_locale), "locale");
lock_locale_mutex ();
c_locale->category_mask = LC_ALL_MASK;
c_locale->base_locale = SCM_UNDEFINED;
current_locale = setlocale (LC_ALL, NULL);
if (current_locale != NULL)
c_locale->locale_name = scm_gc_strdup (current_locale, "locale");
else
err = EINVAL;
unlock_locale_mutex ();
if (err == 0)
SCM_NEWSMOB (*result, scm_tc16_locale_smob_type, c_locale);
else
*result = SCM_BOOL_F;
return err;
}
#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; \
locale_t old_loc; \
\
old_loc = uselocale (_c_locale); \
_statement ; \
@ -552,9 +195,6 @@ get_current_locale (SCM *result)
while (0)
#endif /* USE_GNU_LOCALE_API */
/* `make-locale' can take either category lists or single categories (the
`LC_*' integer constants). */
@ -636,7 +276,7 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
int err = 0;
int c_category_mask;
char *c_locale_name;
scm_t_locale c_base_locale, c_locale;
locale_t c_base_locale, c_locale;
SCM_MAKE_VALIDATE (1, category_list, LIST_OR_INTEGER_P);
SCM_VALIDATE_STRING (2, locale_name);
@ -646,8 +286,6 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
FUNC_NAME, 1);
c_locale_name = scm_to_locale_string (locale_name);
#ifdef USE_GNU_LOCALE_API
if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale)))
c_base_locale = LC_GLOBAL_LOCALE;
@ -678,46 +316,6 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
else
SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
#else
c_locale = scm_gc_malloc (sizeof (* c_locale), "locale");
c_locale->category_mask = c_category_mask;
c_locale->locale_name = scm_gc_strdup (c_locale_name, "locale");
free (c_locale_name);
c_locale_name = NULL;
if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale)))
{
/* Get the current locale settings and turn them into a locale
object. */
err = get_current_locale (&base_locale);
if (err)
goto fail;
}
c_locale->base_locale = base_locale;
{
/* Try out the new locale and raise an exception if it doesn't work. */
int err;
scm_t_locale_settings prev_locale;
err = enter_locale_section (c_locale, &prev_locale);
if (err)
goto fail;
else
{
leave_locale_section (&prev_locale);
SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
}
}
/* silence gcc's unused variable warning */
(void) c_base_locale;
#endif
return locale;
fail:
@ -784,7 +382,7 @@ compare_strings (SCM s1, SCM s2, SCM locale, const char *func_name)
#define FUNC_NAME func_name
{
int result;
scm_t_locale c_locale;
locale_t c_locale;
uint8_t *c_s1, *c_s2;
SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
@ -837,7 +435,7 @@ compare_u32_strings_ci (SCM s1, SCM s2, SCM locale, const char *func_name)
#define FUNC_NAME func_name
{
int result, ret = 0;
scm_t_locale c_locale;
locale_t c_locale;
scm_t_wchar *c_s1, *c_s2;
int c_s1_malloc_p, c_s2_malloc_p;
SCM_VALIDATE_OPTIONAL_LOCALE_COPY (3, locale, c_locale);
@ -1109,7 +707,7 @@ u32_locale_tocase (const uint32_t *c_s1, size_t len,
static SCM
chr_to_case (SCM chr, scm_t_locale c_locale,
chr_to_case (SCM chr, locale_t c_locale,
uint32_t *(*func) (const uint32_t *, size_t, const char *,
uninorm_t, uint32_t *, size_t *),
const char *func_name,
@ -1153,7 +751,7 @@ SCM_DEFINE (scm_char_locale_downcase, "char-locale-downcase", 1, 1, 0,
"according to either @var{locale} or the current locale.")
#define FUNC_NAME s_scm_char_locale_downcase
{
scm_t_locale c_locale;
locale_t c_locale;
SCM ret;
int err = 0;
@ -1177,7 +775,7 @@ SCM_DEFINE (scm_char_locale_upcase, "char-locale-upcase", 1, 1, 0,
"according to either @var{locale} or the current locale.")
#define FUNC_NAME s_scm_char_locale_upcase
{
scm_t_locale c_locale;
locale_t c_locale;
SCM ret;
int err = 0;
@ -1201,7 +799,7 @@ SCM_DEFINE (scm_char_locale_titlecase, "char-locale-titlecase", 1, 1, 0,
"according to either @var{locale} or the current locale.")
#define FUNC_NAME s_scm_char_locale_titlecase
{
scm_t_locale c_locale;
locale_t c_locale;
SCM ret;
int err = 0;
@ -1220,7 +818,7 @@ SCM_DEFINE (scm_char_locale_titlecase, "char-locale-titlecase", 1, 1, 0,
#undef FUNC_NAME
static SCM
str_to_case (SCM str, scm_t_locale c_locale,
str_to_case (SCM str, locale_t c_locale,
uint32_t *(*func) (const uint32_t *, size_t, const char *,
uninorm_t, uint32_t *, size_t *),
const char *func_name,
@ -1275,7 +873,7 @@ SCM_DEFINE (scm_string_locale_upcase, "string-locale-upcase", 1, 1, 0,
"locale.")
#define FUNC_NAME s_scm_string_locale_upcase
{
scm_t_locale c_locale;
locale_t c_locale;
SCM ret;
int err = 0;
@ -1300,7 +898,7 @@ SCM_DEFINE (scm_string_locale_downcase, "string-locale-downcase", 1, 1, 0,
"locale.")
#define FUNC_NAME s_scm_string_locale_downcase
{
scm_t_locale c_locale;
locale_t c_locale;
SCM ret;
int err = 0;
@ -1325,7 +923,7 @@ SCM_DEFINE (scm_string_locale_titlecase, "string-locale-titlecase", 1, 1, 0,
"locale.")
#define FUNC_NAME s_scm_string_locale_titlecase
{
scm_t_locale c_locale;
locale_t c_locale;
SCM ret;
int err = 0;
@ -1366,7 +964,7 @@ SCM_DEFINE (scm_locale_string_to_integer, "locale-string->integer",
int c_base;
const char *c_str;
char *c_endptr;
scm_t_locale c_locale;
locale_t c_locale;
SCM_VALIDATE_STRING (1, str);
c_str = scm_i_string_chars (str);
@ -1380,7 +978,7 @@ SCM_DEFINE (scm_locale_string_to_integer, "locale-string->integer",
if (c_locale != NULL)
{
#if defined USE_GNU_LOCALE_API && defined HAVE_STRTOL_L
#ifdef HAVE_STRTOL_L
c_result = strtol_l (c_str, &c_endptr, c_base, c_locale);
#else
RUN_IN_LOCALE_SECTION (c_locale,
@ -1415,7 +1013,7 @@ SCM_DEFINE (scm_locale_string_to_inexact, "locale-string->inexact",
double c_result;
const char *c_str;
char *c_endptr;
scm_t_locale c_locale;
locale_t c_locale;
SCM_VALIDATE_STRING (1, str);
c_str = scm_i_string_chars (str);
@ -1424,7 +1022,7 @@ SCM_DEFINE (scm_locale_string_to_inexact, "locale-string->inexact",
if (c_locale != NULL)
{
#if defined USE_GNU_LOCALE_API && defined HAVE_STRTOD_L
#ifdef HAVE_STRTOD_L
c_result = strtod_l (c_str, &c_endptr, c_locale);
#else
RUN_IN_LOCALE_SECTION (c_locale,
@ -1494,7 +1092,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
SCM result;
nl_item c_item;
char *c_result;
scm_t_locale c_locale;
locale_t c_locale;
char *codeset;
SCM_VALIDATE_INT_COPY (2, item, c_item);
@ -1510,38 +1108,14 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
lock_locale_mutex ();
if (c_locale != NULL)
{
#ifdef USE_GNU_LOCALE_API
#ifdef HAVE_NL_LANGINFO_L
c_result = copy_string_or_null (nl_langinfo_l (c_item, c_locale));
codeset = copy_string_or_null (nl_langinfo_l (CODESET, c_locale));
#else /* !USE_GNU_LOCALE_API */
/* We can't use `RUN_IN_LOCALE_SECTION ()' here because the locale
mutex is already taken. */
int lsec_err;
scm_t_locale_settings lsec_prev_locale;
lsec_err = get_current_locale_settings (&lsec_prev_locale);
if (lsec_err)
unlock_locale_mutex ();
else
{
lsec_err = install_locale (c_locale);
if (lsec_err)
{
leave_locale_section (&lsec_prev_locale);
free_locale_settings (&lsec_prev_locale);
}
}
if (lsec_err)
scm_locale_error (FUNC_NAME, lsec_err);
else
{
#else
locale_t old_loc = uselocale (c_locale);
c_result = copy_string_or_null (nl_langinfo (c_item));
codeset = copy_string_or_null (nl_langinfo (CODESET));
restore_locale_settings (&lsec_prev_locale);
free_locale_settings (&lsec_prev_locale);
}
uselocale (old_loc);
#endif
}
else

6
libguile/posix.c
View file

@ -116,11 +116,7 @@ verify (WEXITSTATUS (W_EXITCODE (127, 0)) == 127);
#include <locale.h>
#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
# define USE_GNU_LOCALE_API
#endif
#if (defined USE_GNU_LOCALE_API) && (defined HAVE_XLOCALE_H)
#ifdef HAVE_XLOCALE_H
# include <xlocale.h>
#endif

1
libguile/r6rs-ports.c
View file

@ -36,7 +36,6 @@
#include "numbers.h"
#include "ports-internal.h"
#include "procs.h"
#include "smob.h"
#include "strings.h"
#include "symbols.h"
#include "syscalls.h"