}
if (! default_name || strEQ(default_name, "")) {
- default_name = "C";
+ default_name = "C";
}
else if (PL_scopestack_ix != 0) {
SAVEFREEPV(default_name);
&& strNE(env_override, ""))
? env_override
: default_name;
- emulate_setlocale(categories[i], this_locale, i, TRUE);
+ if (! emulate_setlocale(categories[i], this_locale, i, TRUE))
+ {
+ Safefree(env_override);
+ return NULL;
+ }
if (strNE(this_locale, default_name)) {
did_override = TRUE;
/* Parse through the locale name */
name_start = p;
- while (isGRAPH(*p) && *p != ';') {
+ while (p < e && *p != ';') {
+ if (! isGRAPH(*p)) {
+ Perl_croak(aTHX_
+ "panic: %s: %d: Unexpected character in locale name '%02X",
+ __FILE__, __LINE__, *(p-1));
+ }
p++;
}
name_end = p;
- if (*p++ != ';') {
- Perl_croak(aTHX_
- "panic: %s: %d: Unexpected character in locale name '%02X",
- __FILE__, __LINE__, *(p-1));
+ /* Space past the semi-colon */
+ if (p < e) {
+ p++;
}
/* Find the index of the category name in our lists */
}
assert(category == LC_ALL);
- individ_locale = Perl_form(aTHX_ "%.*s", (int) (p - s), s);
- emulate_setlocale(categories[i], individ_locale, i, TRUE);
+ individ_locale = Perl_form(aTHX_ "%.*s",
+ (int) (name_end - name_start), name_start);
+ if (! emulate_setlocale(categories[i], individ_locale, i, TRUE))
+ {
+ return NULL;
+ }
}
s = p;
|| defined(HAS_NL_LANGINFO))
const char * radix = (use_locale)
- ? my_nl_langinfo(PERL_RADIXCHAR, FALSE)
+ ? my_nl_langinfo(RADIXCHAR, FALSE)
/* FALSE => already in dest locale */
: ".";
PL_numeric_underlying = TRUE;
PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
+#ifndef TS_W32_BROKEN_LOCALECONV
+
/* If its name isn't C nor POSIX, it could still be indistinguishable from
- * them */
+ * them. But on broken Windows systems calling my_nl_langinfo() for
+ * THOUSEP can currently (but rarely) cause a race, so avoid doing that,
+ * and just always change the locale if not C nor POSIX on those systems */
if (! PL_numeric_standard) {
- PL_numeric_standard = cBOOL(strEQ(".", my_nl_langinfo(PERL_RADIXCHAR,
+ PL_numeric_standard = cBOOL(strEQ(".", my_nl_langinfo(RADIXCHAR,
FALSE /* Don't toggle locale */ ))
- && strEQ("", my_nl_langinfo(PERL_THOUSEP,
- FALSE)));
+ && strEQ("", my_nl_langinfo(THOUSEP, FALSE)));
}
+#endif
+
/* Save the new name if it isn't the same as the previous one, if any */
if (! PL_numeric_name || strNE(PL_numeric_name, save_newnum)) {
Safefree(PL_numeric_name);
Perl_sv_catpvf(aTHX_ PL_warn_locale, "; codeset=%s",
/* parameter FALSE is a don't care here */
- my_nl_langinfo(PERL_CODESET, FALSE));
+ my_nl_langinfo(CODESET, FALSE));
# endif
as Windows, hence makes your code more portable. Of the fifty-some possible
items specified by the POSIX 2008 standard,
L<http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/langinfo.h.html>,
-only two are completely unimplemented (though the loss of one of these is
-significant). It uses various techniques to recover the other items, including
-calling C<L<localeconv(3)>>, and C<L<strftime(3)>>, both of which are specified
-in C89, so should be always be available. Later C<strftime()> versions have
-additional capabilities; C<""> is returned for those not available on your
-system.
+only one is completely unimplemented, though on non-Windows platforms, another
+significant one is also not implemented). It uses various techniques to
+recover the other items, including calling C<L<localeconv(3)>>, and
+C<L<strftime(3)>>, both of which are specified in C89, so should be always be
+available. Later C<strftime()> versions have additional capabilities; C<""> is
+returned for those not available on your system.
It is important to note that when called with an item that is recovered by
using C<localeconv>, the buffer from any previous explicit call to
C<localeconv> will be overwritten. This means you must save that buffer's
-contents if you need to access them after a call to this function.
-
-The details for those items which may differ from what this emulation returns
-and what a native C<nl_langinfo()> would return are:
-
-=over
-
-=item C<CODESET>
-
-=item C<ERA>
-
-Unimplemented, so returns C<"">.
-
-=item C<YESEXPR>
-
-=item C<YESSTR>
-
-=item C<NOEXPR>
-
-=item C<NOSTR>
-
-Only the values for English are returned. C<YESSTR> and C<NOSTR> have been
-removed from POSIX 2008, and are retained here for backwards compatibility.
-Your platform's C<nl_langinfo> may not support them.
-
-=item C<D_FMT>
-
-Always evaluates to C<%x>, the locale's appropriate date representation.
-
-=item C<T_FMT>
-
-Always evaluates to C<%X>, the locale's appropriate time representation.
-
-=item C<D_T_FMT>
-
-Always evaluates to C<%c>, the locale's appropriate date and time
-representation.
-
-=item C<CRNCYSTR>
-
-The return may be incorrect for those rare locales where the currency symbol
-replaces the radix character.
-Send email to L<mailto:perlbug@perl.org> if you have examples of it needing
-to work differently.
-
-=item C<ALT_DIGITS>
-
-Currently this gives the same results as Linux does.
-Send email to L<mailto:perlbug@perl.org> if you have examples of it needing
-to work differently.
-
-=item C<ERA_D_FMT>
-
-=item C<ERA_T_FMT>
+contents if you need to access them after a call to this function. (But note
+that you might not want to be using C<localeconv()> directly anyway, because of
+issues like the ones listed in the second item of this list (above) for
+C<RADIXCHAR> and C<THOUSEP>. You can use the methods given in L<perlcall> to
+call L<POSIX/localeconv> and avoid all the issues, but then you have a hash to
+unpack).
-=item C<ERA_D_T_FMT>
-
-=item C<T_FMT_AMPM>
-
-These are derived by using C<strftime()>, and not all versions of that function
-know about them. C<""> is returned for these on such systems.
-
-=back
+The details for those items which may deviate from what this emulation returns
+and what a native C<nl_langinfo()> would return are specified in
+L<I18N::Langinfo>.
=back
before the C<perl.h> C<#include>. You can replace your C<langinfo.h>
C<#include> with this one. (Doing it this way keeps out the symbols that plain
-C<langinfo.h> imports into the namespace for code that doesn't need it.)
-
-You also should not use the bare C<langinfo.h> item names, but should preface
-them with C<PERL_>, so use C<PERL_RADIXCHAR> instead of plain C<RADIXCHAR>.
-The C<PERL_I<foo>> versions will also work for this function on systems that do
-have a native C<nl_langinfo>.
+C<langinfo.h> would try to import into the namespace for code that doesn't need
+it.)
The original impetus for C<Perl_langinfo()> was so that code that needs to
find out the current currency symbol, floating point radix character, or digit
return my_nl_langinfo(item, TRUE);
}
-const char *
+STATIC const char *
#ifdef HAS_NL_LANGINFO
S_my_nl_langinfo(const nl_item item, bool toggle)
#else
/* We only need to toggle into the underlying LC_NUMERIC locale for these
* two items, and only if not already there */
- if (toggle && (( item != PERL_RADIXCHAR && item != PERL_THOUSEP)
+ if (toggle && (( item != RADIXCHAR && item != THOUSEP)
|| PL_numeric_underlying))
{
toggle = FALSE;
# endif
if (strEQ(retval, "")) {
- if (item == PERL_YESSTR) {
+ if (item == YESSTR) {
return "yes";
}
- if (item == PERL_NOSTR) {
+ if (item == NOSTR) {
return "no";
}
}
const char * temp;
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ const char * save_global;
+ const char * save_thread;
+ int needed_size;
+ char * ptr;
+ char * e;
+ char * item_start;
+
+# endif
# endif
# ifdef HAS_STRFTIME
switch (item) {
Size_t len;
- /* These 2 are unimplemented */
- case PERL_CODESET:
- case PERL_ERA: /* For use with strftime() %E modifier */
+ /* This is unimplemented */
+ case ERA: /* For use with strftime() %E modifier */
default:
return "";
/* We use only an English set, since we don't know any more */
- case PERL_YESEXPR: return "^[+1yY]";
- case PERL_YESSTR: return "yes";
- case PERL_NOEXPR: return "^[-0nN]";
- case PERL_NOSTR: return "no";
+ case YESEXPR: return "^[+1yY]";
+ case YESSTR: return "yes";
+ case NOEXPR: return "^[-0nN]";
+ case NOSTR: return "no";
+
+ case CODESET:
+
+# ifndef WIN32
+
+ /* On non-windows, this is unimplemented, in part because of
+ * inconsistencies between vendors. The Darwin native
+ * nl_langinfo() implementation simply looks at everything past
+ * any dot in the name, but that doesn't work for other
+ * vendors. Many Linux locales that don't have UTF-8 in their
+ * names really are UTF-8, for example; z/OS locales that do
+ * have UTF-8 in their names, aren't really UTF-8 */
+ return "";
+
+# else
+
+ { /* But on Windows, the name does seem to be consistent, so
+ use that. */
+ const char * p;
+ const char * first;
+ Size_t offset = 0;
+ const char * name = my_setlocale(LC_CTYPE, NULL);
+ if (isNAME_C_OR_POSIX(name)) {
+ return "ANSI_X3.4-1968";
+ }
+
+ /* Find the dot in the locale name */
+ first = (const char *) strchr(name, '.');
+ if (! first) {
+ first = name;
+ goto has_nondigit;
+ }
+
+ /* Look at everything past the dot */
+ first++;
+ p = first;
+
+ while (*p) {
+ if (! isDIGIT(*p)) {
+ goto has_nondigit;
+ }
+
+ p++;
+ }
+
+ /* Here everything past the dot is a digit. Treat it as a
+ * code page */
+ save_to_buffer("CP", &PL_langinfo_buf,
+ &PL_langinfo_bufsize, 0);
+ offset = STRLENs("CP");
+
+ has_nondigit:
+
+ retval = save_to_buffer(first, &PL_langinfo_buf,
+ &PL_langinfo_bufsize, offset);
+ }
+
+ break;
+
+# endif
# ifdef HAS_LOCALECONV
- case PERL_CRNCYSTR:
+ case CRNCYSTR:
/* We don't bother with localeconv_l() because any system that
* has it is likely to also have nl_langinfo() */
- LOCALE_LOCK; /* Prevent interference with other threads
- using localeconv() */
+ LOCALE_LOCK_V; /* Prevent interference with other threads
+ using localeconv() */
+
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ /* This is a workaround for a Windows bug prior to VS 15.
+ * What we do here is, while locked, switch to the global
+ * locale so localeconv() works; then switch back just before
+ * the unlock. This can screw things up if some thread is
+ * already using the global locale while assuming no other is.
+ * A different workaround would be to call GetCurrencyFormat on
+ * a known value, and parse it; patches welcome
+ *
+ * We have to use LC_ALL instead of LC_MONETARY because of
+ * another bug in Windows */
+
+ save_thread = savepv(my_setlocale(LC_ALL, NULL));
+ _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+ save_global= savepv(my_setlocale(LC_ALL, NULL));
+ my_setlocale(LC_ALL, save_thread);
+
+# endif
lc = localeconv();
if ( ! lc
|| ! lc->currency_symbol
|| strEQ("", lc->currency_symbol))
{
- LOCALE_UNLOCK;
+ LOCALE_UNLOCK_V;
return "";
}
PL_langinfo_buf[0] = '+';
}
- LOCALE_UNLOCK;
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ my_setlocale(LC_ALL, save_global);
+ _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+ my_setlocale(LC_ALL, save_thread);
+ Safefree(save_global);
+ Safefree(save_thread);
+
+# endif
+
+ LOCALE_UNLOCK_V;
+ break;
+
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ case RADIXCHAR:
+
+ /* For this, we output a known simple floating point number to
+ * a buffer, and parse it, looking for the radix */
+
+ if (toggle) {
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
+ }
+
+ if (PL_langinfo_bufsize < 10) {
+ PL_langinfo_bufsize = 10;
+ Renew(PL_langinfo_buf, PL_langinfo_bufsize, char);
+ }
+
+ needed_size = my_snprintf(PL_langinfo_buf, PL_langinfo_bufsize,
+ "%.1f", 1.5);
+ if (needed_size >= (int) PL_langinfo_bufsize) {
+ PL_langinfo_bufsize = needed_size + 1;
+ Renew(PL_langinfo_buf, PL_langinfo_bufsize, char);
+ needed_size = my_snprintf(PL_langinfo_buf, PL_langinfo_bufsize,
+ "%.1f", 1.5);
+ assert(needed_size < (int) PL_langinfo_bufsize);
+ }
+
+ ptr = PL_langinfo_buf;
+ e = PL_langinfo_buf + PL_langinfo_bufsize;
+
+ /* Find the '1' */
+ while (ptr < e && *ptr != '1') {
+ ptr++;
+ }
+ ptr++;
+
+ /* Find the '5' */
+ item_start = ptr;
+ while (ptr < e && *ptr != '5') {
+ ptr++;
+ }
+
+ /* Everything in between is the radix string */
+ if (ptr >= e) {
+ PL_langinfo_buf[0] = '?';
+ PL_langinfo_buf[1] = '\0';
+ }
+ else {
+ *ptr = '\0';
+ Move(item_start, PL_langinfo_buf, ptr - PL_langinfo_buf, char);
+ }
+
+ if (toggle) {
+ RESTORE_LC_NUMERIC();
+ }
+
+ retval = PL_langinfo_buf;
break;
- case PERL_RADIXCHAR:
- case PERL_THOUSEP:
+# else
+
+ case RADIXCHAR: /* No special handling needed */
+
+# endif
+
+ case THOUSEP:
if (toggle) {
STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
}
- LOCALE_LOCK; /* Prevent interference with other threads
- using localeconv() */
+ LOCALE_LOCK_V; /* Prevent interference with other threads
+ using localeconv() */
+
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ /* This should only be for the thousands separator. A
+ * different work around would be to use GetNumberFormat on a
+ * known value and parse the result to find the separator */
+ save_thread = savepv(my_setlocale(LC_ALL, NULL));
+ _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+ save_global = savepv(my_setlocale(LC_ALL, NULL));
+ my_setlocale(LC_ALL, save_thread);
+# if 0
+ /* This is the start of code that for broken Windows replaces
+ * the above and below code, and instead calls
+ * GetNumberFormat() and then would parse that to find the
+ * thousands separator. It needs to handle UTF-16 vs -8
+ * issues. */
+
+ needed_size = GetNumberFormatEx(PL_numeric_name, 0, "1234.5", NULL, PL_langinfo_buf, PL_langinfo_bufsize);
+ DEBUG_L(PerlIO_printf(Perl_debug_log,
+ "%s: %d: return from GetNumber, count=%d, val=%s\n",
+ __FILE__, __LINE__, needed_size, PL_langinfo_buf));
+
+# endif
+# endif
lc = localeconv();
if (! lc) {
temp = "";
}
else {
- temp = (item == PERL_RADIXCHAR)
+ temp = (item == RADIXCHAR)
? lc->decimal_point
: lc->thousands_sep;
if (! temp) {
retval = save_to_buffer(temp, &PL_langinfo_buf,
&PL_langinfo_bufsize, 0);
- LOCALE_UNLOCK;
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ my_setlocale(LC_ALL, save_global);
+ _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+ my_setlocale(LC_ALL, save_thread);
+ Safefree(save_global);
+ Safefree(save_thread);
+
+# endif
+
+ LOCALE_UNLOCK_V;
if (toggle) {
RESTORE_LC_NUMERIC();
* for someone using them as formats (as opposed to trying to parse
* them to figure out what the locale says). The other format
* items are actually tested to verify they work on the platform */
- case PERL_D_FMT: return "%x";
- case PERL_T_FMT: return "%X";
- case PERL_D_T_FMT: return "%c";
+ case D_FMT: return "%x";
+ case T_FMT: return "%X";
+ case D_T_FMT: return "%c";
/* These formats are only available in later strfmtime's */
- case PERL_ERA_D_FMT: case PERL_ERA_T_FMT: case PERL_ERA_D_T_FMT:
- case PERL_T_FMT_AMPM:
+ case ERA_D_FMT: case ERA_T_FMT: case ERA_D_T_FMT: case T_FMT_AMPM:
/* The rest can be gotten from most versions of strftime(). */
- case PERL_ABDAY_1: case PERL_ABDAY_2: case PERL_ABDAY_3:
- case PERL_ABDAY_4: case PERL_ABDAY_5: case PERL_ABDAY_6:
- case PERL_ABDAY_7:
- case PERL_ALT_DIGITS:
- case PERL_AM_STR: case PERL_PM_STR:
- case PERL_ABMON_1: case PERL_ABMON_2: case PERL_ABMON_3:
- case PERL_ABMON_4: case PERL_ABMON_5: case PERL_ABMON_6:
- case PERL_ABMON_7: case PERL_ABMON_8: case PERL_ABMON_9:
- case PERL_ABMON_10: case PERL_ABMON_11: case PERL_ABMON_12:
- case PERL_DAY_1: case PERL_DAY_2: case PERL_DAY_3: case PERL_DAY_4:
- case PERL_DAY_5: case PERL_DAY_6: case PERL_DAY_7:
- case PERL_MON_1: case PERL_MON_2: case PERL_MON_3: case PERL_MON_4:
- case PERL_MON_5: case PERL_MON_6: case PERL_MON_7: case PERL_MON_8:
- case PERL_MON_9: case PERL_MON_10: case PERL_MON_11:
- case PERL_MON_12:
+ case ABDAY_1: case ABDAY_2: case ABDAY_3:
+ case ABDAY_4: case ABDAY_5: case ABDAY_6: case ABDAY_7:
+ case ALT_DIGITS:
+ case AM_STR: case PM_STR:
+ case ABMON_1: case ABMON_2: case ABMON_3: case ABMON_4:
+ case ABMON_5: case ABMON_6: case ABMON_7: case ABMON_8:
+ case ABMON_9: case ABMON_10: case ABMON_11: case ABMON_12:
+ case DAY_1: case DAY_2: case DAY_3: case DAY_4:
+ case DAY_5: case DAY_6: case DAY_7:
+ case MON_1: case MON_2: case MON_3: case MON_4:
+ case MON_5: case MON_6: case MON_7: case MON_8:
+ case MON_9: case MON_10: case MON_11: case MON_12:
LOCALE_LOCK;
__FILE__, __LINE__, item);
NOT_REACHED; /* NOTREACHED */
- case PERL_PM_STR: tm.tm_hour = 18;
- case PERL_AM_STR:
+ case PM_STR: tm.tm_hour = 18;
+ case AM_STR:
format = "%p";
break;
- case PERL_ABDAY_7: tm.tm_wday++;
- case PERL_ABDAY_6: tm.tm_wday++;
- case PERL_ABDAY_5: tm.tm_wday++;
- case PERL_ABDAY_4: tm.tm_wday++;
- case PERL_ABDAY_3: tm.tm_wday++;
- case PERL_ABDAY_2: tm.tm_wday++;
- case PERL_ABDAY_1:
+ case ABDAY_7: tm.tm_wday++;
+ case ABDAY_6: tm.tm_wday++;
+ case ABDAY_5: tm.tm_wday++;
+ case ABDAY_4: tm.tm_wday++;
+ case ABDAY_3: tm.tm_wday++;
+ case ABDAY_2: tm.tm_wday++;
+ case ABDAY_1:
format = "%a";
break;
- case PERL_DAY_7: tm.tm_wday++;
- case PERL_DAY_6: tm.tm_wday++;
- case PERL_DAY_5: tm.tm_wday++;
- case PERL_DAY_4: tm.tm_wday++;
- case PERL_DAY_3: tm.tm_wday++;
- case PERL_DAY_2: tm.tm_wday++;
- case PERL_DAY_1:
+ case DAY_7: tm.tm_wday++;
+ case DAY_6: tm.tm_wday++;
+ case DAY_5: tm.tm_wday++;
+ case DAY_4: tm.tm_wday++;
+ case DAY_3: tm.tm_wday++;
+ case DAY_2: tm.tm_wday++;
+ case DAY_1:
format = "%A";
break;
- case PERL_ABMON_12: tm.tm_mon++;
- case PERL_ABMON_11: tm.tm_mon++;
- case PERL_ABMON_10: tm.tm_mon++;
- case PERL_ABMON_9: tm.tm_mon++;
- case PERL_ABMON_8: tm.tm_mon++;
- case PERL_ABMON_7: tm.tm_mon++;
- case PERL_ABMON_6: tm.tm_mon++;
- case PERL_ABMON_5: tm.tm_mon++;
- case PERL_ABMON_4: tm.tm_mon++;
- case PERL_ABMON_3: tm.tm_mon++;
- case PERL_ABMON_2: tm.tm_mon++;
- case PERL_ABMON_1:
+ case ABMON_12: tm.tm_mon++;
+ case ABMON_11: tm.tm_mon++;
+ case ABMON_10: tm.tm_mon++;
+ case ABMON_9: tm.tm_mon++;
+ case ABMON_8: tm.tm_mon++;
+ case ABMON_7: tm.tm_mon++;
+ case ABMON_6: tm.tm_mon++;
+ case ABMON_5: tm.tm_mon++;
+ case ABMON_4: tm.tm_mon++;
+ case ABMON_3: tm.tm_mon++;
+ case ABMON_2: tm.tm_mon++;
+ case ABMON_1:
format = "%b";
break;
- case PERL_MON_12: tm.tm_mon++;
- case PERL_MON_11: tm.tm_mon++;
- case PERL_MON_10: tm.tm_mon++;
- case PERL_MON_9: tm.tm_mon++;
- case PERL_MON_8: tm.tm_mon++;
- case PERL_MON_7: tm.tm_mon++;
- case PERL_MON_6: tm.tm_mon++;
- case PERL_MON_5: tm.tm_mon++;
- case PERL_MON_4: tm.tm_mon++;
- case PERL_MON_3: tm.tm_mon++;
- case PERL_MON_2: tm.tm_mon++;
- case PERL_MON_1:
+ case MON_12: tm.tm_mon++;
+ case MON_11: tm.tm_mon++;
+ case MON_10: tm.tm_mon++;
+ case MON_9: tm.tm_mon++;
+ case MON_8: tm.tm_mon++;
+ case MON_7: tm.tm_mon++;
+ case MON_6: tm.tm_mon++;
+ case MON_5: tm.tm_mon++;
+ case MON_4: tm.tm_mon++;
+ case MON_3: tm.tm_mon++;
+ case MON_2: tm.tm_mon++;
+ case MON_1:
format = "%B";
break;
- case PERL_T_FMT_AMPM:
+ case T_FMT_AMPM:
format = "%r";
return_format = TRUE;
break;
- case PERL_ERA_D_FMT:
+ case ERA_D_FMT:
format = "%Ex";
return_format = TRUE;
break;
- case PERL_ERA_T_FMT:
+ case ERA_T_FMT:
format = "%EX";
return_format = TRUE;
break;
- case PERL_ERA_D_T_FMT:
+ case ERA_D_T_FMT:
format = "%Ec";
return_format = TRUE;
break;
- case PERL_ALT_DIGITS:
+ case ALT_DIGITS:
tm.tm_wday = 0;
format = "%Ow"; /* Find the alternate digit for 0 */
break;
* alternate format for wday 0. If the value is the same as
* the normal 0, there isn't an alternate, so clear the buffer.
* */
- if ( item == PERL_ALT_DIGITS
+ if ( item == ALT_DIGITS
&& strEQ(PL_langinfo_buf, "0"))
{
*PL_langinfo_buf = '\0';
# endif
# endif
-# if defined(LC_ALL_MASK) && defined(HAS_POSIX_2008_LOCALE)
+# ifdef USE_POSIX_2008_LOCALE
PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", (locale_t) 0);
if (! PL_C_locale_obj) {
* calculate it */
# if defined(USE_LOCALE_CTYPE) \
- && ( (defined(HAS_NL_LANGINFO) && defined(CODESET)) \
+ && ( defined(HAS_NL_LANGINFO) \
|| (defined(HAS_MBTOWC) || defined(HAS_MBRTOWC)))
{
}
# endif
-# if defined(HAS_NL_LANGINFO) && defined(CODESET)
+# if defined(HAS_NL_LANGINFO)
{ /* The task is easiest if the platform has this POSIX 2001 function.
Except on some platforms it can wrongly return "", so have to have
defective locale definition. XXX We should probably check for
these in the Latin1 range and warn (but on glibc, requires
iswalnum() etc. due to their not handling 80-FF correctly */
- const char *codeset = my_nl_langinfo(PERL_CODESET, FALSE);
+ const char *codeset = my_nl_langinfo(CODESET, FALSE);
/* FALSE => already in dest locale */
DEBUG_Lv(PerlIO_printf(Perl_debug_log,
save_input_locale);
bool only_ascii = FALSE;
const U8 * currency_string
- = (const U8 *) my_nl_langinfo(PERL_CRNCYSTR, FALSE);
+ = (const U8 *) my_nl_langinfo(CRNCYSTR, FALSE);
/* 2nd param not relevant for this item */
const U8 * first_variant;
const bool within_locale_scope = IN_LC(LC_MESSAGES);
-# if defined(HAS_POSIX_2008_LOCALE) && defined(HAS_STRERROR_L)
+# ifndef USE_ITHREADS
- /* This function is trivial if we don't have to worry about thread safety
- * and have strerror_l(), as it handles the switch of locales so we don't
- * have to deal with that. We don't have to worry about thread safety if
- * this is an unthreaded build, or if strerror_r() is also available. Both
- * it and strerror_l() are thread-safe. Plain strerror() isn't thread
- * safe. But on threaded builds when strerror_r() is available, the
- * apparent call to strerror() below is actually a macro that
- * behind-the-scenes calls strerror_r().
- */
+ /* This function is trivial without threads. */
+ if (within_locale_scope) {
+ errstr = savepv(strerror(errnum));
+ }
+ else {
+ const char * save_locale = do_setlocale_c(LC_MESSAGES, NULL);
-# if ! defined(USE_ITHREADS) || defined(HAS_STRERROR_R)
+ do_setlocale_c(LC_MESSAGES, "C");
+ errstr = savepv(strerror(errnum));
+ do_setlocale_c(LC_MESSAGES, save_locale);
+ }
+
+# elif defined(HAS_POSIX_2008_LOCALE) && defined(HAS_STRERROR_L)
+
+ /* This function is also trivial if we don't have to worry about thread
+ * safety and have strerror_l(), as it handles the switch of locales so we
+ * don't have to deal with that. We don't have to worry about thread
+ * safety if strerror_r() is also available. Both it and strerror_l() are
+ * thread-safe. Plain strerror() isn't thread safe. But on threaded
+ * builds when strerror_r() is available, the apparent call to strerror()
+ * below is actually a macro that behind-the-scenes calls strerror_r(). */
+
+# ifdef HAS_STRERROR_R
if (within_locale_scope) {
errstr = savepv(strerror(errnum));
works fine, as all the other threads continue to ignore the global one, so only
this thread looks at it.
+However, on Windows systems this isn't quite true prior to Visual Studio 15,
+at which point Microsoft fixed a bug. A race can occur if you use the
+following operations on earlier Windows platforms:
+
+=over
+
+=item L<POSIX::localeconv|POSIX/localeconv>
+
+=item L<I18N::Langinfo>, items C<CRNCYSTR> and C<THOUSEP>
+
+=item L<perlapi/Perl_langinfo>, items C<CRNCYSTR> and C<THOUSEP>
+
+=back
+
+The first item is not fixable (except by upgrading to a later Visual Studio
+release), but it would be possible to work around the latter two items by using
+the Windows API functions C<GetNumberFormat> and C<GetCurrencyFormat>; patches
+welcome.
+
Without this function call, threads that use the L<C<setlocale(3)>> system
function will not work properly, as all the locale-sensitive functions will
look at the per-thread locale, and C<setlocale> will have no effect on this
https://perl5.git.perl.org / perl5.git / blobdiff