Skip to content

Commit

Permalink
XXX perldelta Move POSIX::localeconv() logic to locale.c
Browse files Browse the repository at this point in the history 
The code currently in POSIX.xs is moved to locale.c, and reworked some
to fit in that scheme, and the logic for the workaround for the Windows
broken localeconv() is made more robust.

This is in preparation for the next commit which will use this logic
instead of (imperfectly) duplicating it.

This also creates Perl_localeconv() for direct XS calls of this
functionality.
  • Loading branch information
@khwilliamson
khwilliamson committed Apr 29, 2021
1 parent 33556a3 commit 967aed3
Show file tree
Hide file tree
Showing 5 changed files with 400 additions and 204 deletions.
8 changes: 8 additions & 0 deletions embed.fnc
View file
Expand Up @@ -1593,6 +1593,7 @@ ApdO |HV* |get_hv |NN const char *name|I32 flags
ApdO |CV* |get_cv |NN const char* name|I32 flags
Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags
ATdo |const char*|Perl_setlocale|const int category|NULLOK const char* locale
ATdo |HV * |Perl_localeconv
#if defined(HAS_NL_LANGINFO) && defined(PERL_LANGINFO_H)
ATdo |const char*|Perl_langinfo|const nl_item item
#else
Expand Down Expand Up @@ -3224,6 +3225,13 @@ S |unsigned|get_locale_string_utf8ness_i \
|const unsigned cat_index \
|NULLOK const char * string \
|const int known_utf8
# if (defined(HAS_LOCALECONV) || defined(HAS_LOCALECONV_L)) \
&& (defined(USE_LOCALE_MONETARY) || defined(USE_LOCALE_NUMERIC))
S |HV * |my_localeconv
S |HV * |populate_localeconv|NN const struct lconv *lcbuf \
|const int numeric_locale_is_utf8 \
|const int monetary_locale_is_utf8
# endif
# if defined(HAS_NL_LANGINFO) || defined(HAS_NL_LANGINFO_L)
S |const char*|my_langinfo_i|const nl_item item \
|const unsigned int cat_index \
Expand Down
8 changes: 8 additions & 0 deletions embed.h
View file
Expand Up @@ -1572,6 +1572,14 @@
# if !defined(WIN32)
#define do_exec3(a,b,c) Perl_do_exec3(aTHX_ a,b,c)
# endif
# if (defined(HAS_LOCALECONV) || defined(HAS_LOCALECONV_L)) && (defined(USE_LOCALE_MONETARY) || defined(USE_LOCALE_NUMERIC))
# if defined(PERL_IN_LOCALE_C)
# if defined(USE_LOCALE)
#define my_localeconv() S_my_localeconv(aTHX)
#define populate_localeconv(a,b,c) S_populate_localeconv(aTHX_ a,b,c)
# endif
# endif
# endif
# if 0 /* Not currently used, but may be needed in the future */
# if defined(PERL_IN_UTF8_C)
#define warn_on_first_deprecated_use(a,b,c,d,e) S_warn_on_first_deprecated_use(aTHX_ a,b,c,d,e)
Expand Down
205 changes: 1 addition & 204 deletions ext/POSIX/POSIX.xs
View file
Expand Up @@ -1572,80 +1572,6 @@ END_EXTERN_C

#if ! defined(HAS_LOCALECONV) && ! defined(HAS_LOCALECONV_L)
# define localeconv() not_here("localeconv")
#else
struct lconv_offset {
const char *name;
size_t offset;
};

/* Create e.g.,
{"thousands_sep", STRUCT_OFFSET(struct lconv, thousands_sep)},
*/
# define LCONV_ENTRY(name) \
{STRINGIFY(name), STRUCT_OFFSET(struct lconv, name)}

static const struct lconv_offset lconv_strings[] = {

# ifdef USE_LOCALE_NUMERIC
LCONV_ENTRY(decimal_point),
LCONV_ENTRY(thousands_sep),
# ifndef NO_LOCALECONV_GROUPING
LCONV_ENTRY(grouping),
# endif
# endif
# ifdef USE_LOCALE_MONETARY
LCONV_ENTRY(int_curr_symbol),
LCONV_ENTRY(currency_symbol),
LCONV_ENTRY(mon_decimal_point),
# ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
LCONV_ENTRY(mon_thousands_sep),
# endif
# ifndef NO_LOCALECONV_MON_GROUPING
LCONV_ENTRY(mon_grouping),
# endif
LCONV_ENTRY(positive_sign),
LCONV_ENTRY(negative_sign),
# endif
{NULL, 0}
};

# ifdef USE_LOCALE_NUMERIC

/* The Linux man pages say these are the field names for the structure
* components that are LC_NUMERIC; the rest being LC_MONETARY */
# define isLC_NUMERIC_STRING(name) ( strEQ(name, "decimal_point") \
|| strEQ(name, "thousands_sep") \
\
/* There should be no harm done \
* checking for this, even if \
* NO_LOCALECONV_GROUPING */ \
|| strEQ(name, "grouping"))
# else
# define isLC_NUMERIC_STRING(name) (0)
# endif

static const struct lconv_offset lconv_integers[] = {
# ifdef USE_LOCALE_MONETARY
LCONV_ENTRY(int_frac_digits),
LCONV_ENTRY(frac_digits),
LCONV_ENTRY(p_cs_precedes),
LCONV_ENTRY(p_sep_by_space),
LCONV_ENTRY(n_cs_precedes),
LCONV_ENTRY(n_sep_by_space),
LCONV_ENTRY(p_sign_posn),
LCONV_ENTRY(n_sign_posn),
# ifdef HAS_LC_MONETARY_2008
LCONV_ENTRY(int_p_cs_precedes),
LCONV_ENTRY(int_p_sep_by_space),
LCONV_ENTRY(int_n_cs_precedes),
LCONV_ENTRY(int_n_sep_by_space),
LCONV_ENTRY(int_p_sign_posn),
LCONV_ENTRY(int_n_sign_posn),
# endif
# endif
{NULL, 0}
};

#endif /* HAS_LOCALECONV */

#ifdef HAS_LONG_DOUBLE
Expand Down Expand Up @@ -2143,136 +2069,7 @@ localeconv()
#ifndef HAS_LOCALECONV
localeconv(); /* A stub to call not_here(). */
#else
struct lconv *lcbuf;
# if defined(USE_ITHREADS) \
&& defined(USE_POSIX_2008_LOCALE) \
&& defined(HAS_LOCALECONV_L) /* Prefer this thread-safe version */
bool do_free = FALSE;
locale_t cur = NULL;
# elif defined(TS_W32_BROKEN_LOCALECONV)
const char * save_global;
const char * save_thread;
# endif
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;

/* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
* LC_MONETARY is already in the correct locale */
# ifdef USE_LOCALE_MONETARY

const bool is_monetary_utf8 = _is_cur_LC_category_utf8(LC_MONETARY);
# endif
# ifdef USE_LOCALE_NUMERIC

bool is_numeric_utf8;

STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();

is_numeric_utf8 = _is_cur_LC_category_utf8(LC_NUMERIC);
# endif

RETVAL = newHV();
sv_2mortal((SV*)RETVAL);
# if defined(USE_ITHREADS) \
&& defined(USE_POSIX_2008_LOCALE) \
&& defined(HAS_LOCALECONV_L)

cur = uselocale((locale_t) 0);
if (cur == LC_GLOBAL_LOCALE) {
cur = duplocale(LC_GLOBAL_LOCALE);
do_free = TRUE;
}

lcbuf = localeconv_l(cur);
# else
LOCALECONV_LOCK; /* Prevent interference with other threads using
localeconv() */
# ifdef TS_W32_BROKEN_LOCALECONV
/* This is a workaround for a Windows bug prior to VS 15, in which
* localeconv only looks at the global locale. We toggle to the global
* locale; populate the return; then toggle back. We have to use
* LC_ALL instead of the individual ones because of another bug in
* Windows */

save_thread = savepv(Perl_setlocale(LC_NUMERIC, NULL));

_configthreadlocale(_DISABLE_PER_THREAD_LOCALE);

save_global = savepv(Perl_setlocale(LC_ALL, NULL));

Perl_setlocale(LC_ALL, save_thread);
# endif
lcbuf = localeconv();
# endif
if (lcbuf) {
const struct lconv_offset *strings = lconv_strings;
const struct lconv_offset *integers = lconv_integers;
const char *ptr = (const char *) lcbuf;

while (strings->name) {
/* This string may be controlled by either LC_NUMERIC, or
* LC_MONETARY */
const bool is_utf8_locale =
# if defined(USE_LOCALE_NUMERIC) && defined(USE_LOCALE_MONETARY)
(isLC_NUMERIC_STRING(strings->name))
? is_numeric_utf8
: is_monetary_utf8;
# elif defined(USE_LOCALE_NUMERIC)
is_numeric_utf8;
# elif defined(USE_LOCALE_MONETARY)
is_monetary_utf8;
# else
FALSE;
# endif

const char *value = *((const char **)(ptr + strings->offset));

if (value && *value) {
const STRLEN value_len = strlen(value);

/* We mark it as UTF-8 if a utf8 locale and is valid and
* variant under UTF-8 */
const bool is_utf8 = is_utf8_locale
&& is_utf8_non_invariant_string(
(U8*) value,
value_len);
(void) hv_store(RETVAL,
strings->name,
strlen(strings->name),
newSVpvn_utf8(value, value_len, is_utf8),
0);
}
strings++;
}

while (integers->name) {
const char value = *((const char *)(ptr + integers->offset));

if (value != CHAR_MAX)
(void) hv_store(RETVAL, integers->name,
strlen(integers->name), newSViv(value), 0);
integers++;
}
}
# if defined(USE_ITHREADS) \
&& defined(USE_POSIX_2008_LOCALE) \
&& defined(HAS_LOCALECONV_L)
if (do_free) {
freelocale(cur);
}
# else
# ifdef TS_W32_BROKEN_LOCALECONV
Perl_setlocale(LC_ALL, save_global);

_configthreadlocale(_ENABLE_PER_THREAD_LOCALE);

Perl_setlocale(LC_ALL, save_thread);

Safefree(save_global);
Safefree(save_thread);
# endif
LOCALECONV_UNLOCK;
# endif
RESTORE_LC_NUMERIC();
RETVAL = Perl_localeconv();
#endif /* HAS_LOCALECONV */
OUTPUT:
RETVAL
Expand Down

0 comments on commit 967aed3

Please sign in to comment.