# endif
#endif
+/* strlen() of a literal string constant. XXX We might want this more general,
+ * but using it in just this file for now */
+#define STRLENs(s) (sizeof("" s "") - 1)
+
#ifdef USE_LOCALE
/*
#endif
+/* Windows requres a customized base-level setlocale() */
+# ifdef WIN32
+# define my_setlocale(cat, locale) win32_setlocale(cat, locale)
+# else
+# define my_setlocale(cat, locale) setlocale(cat, locale)
+# endif
+
+/* Just placeholders for now. "_c" is intended to be called when the category
+ * is a constant known at compile time; "_r", not known until run time */
+# define do_setlocale_c(category, locale) my_setlocale(category, locale)
+# define do_setlocale_r(category, locale) my_setlocale(category, locale)
+
STATIC void
-S_set_numeric_radix(pTHX)
+S_set_numeric_radix(pTHX_ const bool use_locale)
{
+ /* If 'use_locale' is FALSE, set to use a dot for the radix character. If
+ * TRUE, use the radix character derived from the current locale */
-#ifdef USE_LOCALE_NUMERIC
-# ifdef HAS_LOCALECONV
- const struct lconv* const lc = localeconv();
+#if defined(USE_LOCALE_NUMERIC) && ( defined(HAS_LOCALECONV) \
+ || defined(HAS_NL_LANGINFO))
- if (lc && lc->decimal_point) {
- if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
- SvREFCNT_dec(PL_numeric_radix_sv);
- PL_numeric_radix_sv = NULL;
- }
- else {
- if (PL_numeric_radix_sv)
- sv_setpv(PL_numeric_radix_sv, lc->decimal_point);
- else
- PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0);
- if (! is_utf8_invariant_string((U8 *) lc->decimal_point, 0)
- && is_utf8_string((U8 *) lc->decimal_point, 0)
+ /* We only set up the radix SV if we are to use a locale radix ... */
+ if (use_locale) {
+ const char * radix = my_nl_langinfo(PERL_RADIXCHAR, FALSE);
+ /* FALSE => already in dest locale */
+
+ /* ... and the character being used isn't a dot */
+ if (strNE(radix, ".")) {
+ if (PL_numeric_radix_sv) {
+ sv_setpv(PL_numeric_radix_sv, radix);
+ }
+ else {
+ PL_numeric_radix_sv = newSVpv(radix, 0);
+ }
+
+ if ( ! is_utf8_invariant_string(
+ (U8 *) SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))
+ && is_utf8_string(
+ (U8 *) SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))
&& _is_cur_LC_category_utf8(LC_NUMERIC))
{
- SvUTF8_on(PL_numeric_radix_sv);
+ SvUTF8_on(PL_numeric_radix_sv);
}
- }
+ goto done;
+ }
}
- else
- PL_numeric_radix_sv = NULL;
-# ifdef DEBUGGING
+ SvREFCNT_dec(PL_numeric_radix_sv);
+ PL_numeric_radix_sv = NULL;
+
+ done: ;
+
+# ifdef DEBUGGING
if (DEBUG_L_TEST || debug_initialization) {
PerlIO_printf(Perl_debug_log, "Locale radix is '%s', ?UTF-8=%d\n",
: 0);
}
-# endif
-# endif /* HAS_LOCALECONV */
-#endif /* USE_LOCALE_NUMERIC */
+# endif
+#endif /* USE_LOCALE_NUMERIC and can find the radix char */
}
* the odds are extremely small that it would return these two strings for some
* other locale. Note that VMS in these two locales includes many non-ASCII
* characters as controls and punctuation (below are hex bytes):
- * cntrl: 00-1F 7F 84-97 9B-9F
- * punct: 21-2F 3A-40 5B-60 7B-7E A1-A3 A5 A7-AB B0-B3 B5-B7 B9-BD BF-CF D1-DD DF-EF F1-FD
+ * cntrl: 84-97 9B-9F
+ * punct: A1-A3 A5 A7-AB B0-B3 B5-B7 B9-BD BF-CF D1-DD DF-EF F1-FD
* Oddly, none there are listed as alphas, though some represent alphabetics
* http://www.nntp.perl.org/group/perl.perl5.porters/2013/02/msg198753.html */
#define isNAME_C_OR_POSIX(name) \
* It installs this locale as the current underlying default.
*
* The default locale and the C locale can be toggled between by use of the
- * set_numeric_local() and set_numeric_standard() functions, which should
- * probably not be called directly, but only via macros like
+ * set_numeric_underlying() and set_numeric_standard() functions, which
+ * should probably not be called directly, but only via macros like
* SET_NUMERIC_STANDARD() in perl.h.
*
* The toggling is necessary mainly so that a non-dot radix decimal point
*
* This sets several interpreter-level variables:
* PL_numeric_name The underlying locale's name: a copy of 'newnum'
- * PL_numeric_local A boolean indicating if the toggled state is such
+ * PL_numeric_underlying A boolean indicating if the toggled state is such
* that the current locale is the program's underlying
* locale
* PL_numeric_standard An int indicating if the toggled state is such
Safefree(PL_numeric_name);
PL_numeric_name = NULL;
PL_numeric_standard = TRUE;
- PL_numeric_local = TRUE;
+ PL_numeric_underlying = TRUE;
return;
}
save_newnum = stdize_locale(savepv(newnum));
PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
- PL_numeric_local = TRUE;
+ PL_numeric_underlying = TRUE;
if (! PL_numeric_name || strNE(PL_numeric_name, save_newnum)) {
Safefree(PL_numeric_name);
* to our records (which could be wrong if some XS code has changed the
* locale behind our back) */
- setlocale(LC_NUMERIC, "C");
+ do_setlocale_c(LC_NUMERIC, "C");
PL_numeric_standard = TRUE;
- PL_numeric_local = isNAME_C_OR_POSIX(PL_numeric_name);
- set_numeric_radix();
+ PL_numeric_underlying = isNAME_C_OR_POSIX(PL_numeric_name);
+ set_numeric_radix(0);
# ifdef DEBUGGING
if (DEBUG_L_TEST || debug_initialization) {
PerlIO_printf(Perl_debug_log,
- "Underlying LC_NUMERIC locale now is C\n");
+ "LC_NUMERIC locale now is standard C\n");
}
# endif
}
void
-Perl_set_numeric_local(pTHX)
+Perl_set_numeric_underlying(pTHX)
{
#ifdef USE_LOCALE_NUMERIC
* if toggling isn't necessary according to our records (which could be
* wrong if some XS code has changed the locale behind our back) */
- setlocale(LC_NUMERIC, PL_numeric_name);
+ do_setlocale_c(LC_NUMERIC, PL_numeric_name);
PL_numeric_standard = isNAME_C_OR_POSIX(PL_numeric_name);
- PL_numeric_local = TRUE;
- set_numeric_radix();
+ PL_numeric_underlying = TRUE;
+ set_numeric_radix(1);
# ifdef DEBUGGING
if (DEBUG_L_TEST || debug_initialization) {
PerlIO_printf(Perl_debug_log,
- "Underlying LC_NUMERIC locale now is %s\n",
+ "LC_NUMERIC locale now is %s\n",
PL_numeric_name);
}
* here is transparent to this function's caller */
const char * const badlocale = savepv(newctype);
- setlocale(LC_CTYPE, "C");
+ do_setlocale_c(LC_CTYPE, "C");
/* The '0' below suppresses a bogus gcc compiler warning */
Perl_warner(aTHX_ packWARN(WARN_LOCALE), SvPVX(PL_warn_locale), 0);
- setlocale(LC_CTYPE, badlocale);
+ do_setlocale_c(LC_CTYPE, badlocale);
Safefree(badlocale);
if (IN_LC(LC_CTYPE)) {
}
-#ifndef WIN32 /* No wrapper except on Windows */
-
-# define my_setlocale(a,b) setlocale(a,b)
-
-#else /* WIN32 */
+#ifdef WIN32
STATIC char *
-S_my_setlocale(pTHX_ int category, const char* locale)
+S_win32_setlocale(pTHX_ int category, const char* locale)
{
/* This, for Windows, emulates POSIX setlocale() behavior. There is no
* difference between the two unless the input locale is "", which normally
/* This wraps POSIX::setlocale() */
char * retval;
+ char * newlocale;
dTHX;
#ifdef USE_LOCALE_NUMERIC
#endif
- retval = my_setlocale(category, locale);
+ retval = do_setlocale_r(category, locale);
DEBUG_L(PerlIO_printf(Perl_debug_log,
"%s:%d: %s\n", __FILE__, __LINE__,
SET_NUMERIC_STANDARD();
return retval;
}
- else { /* Now that have switched locales, we have to update our records to
- correspond */
-
-#ifdef USE_LOCALE_CTYPE
- if ( category == LC_CTYPE
+ /* Now that have switched locales, we have to update our records to
+ * correspond. */
-# ifdef LC_ALL
-
- || category == LC_ALL
-
-# endif
-
- )
- {
- char *newctype;
-
-# ifdef LC_ALL
-
- if (category == LC_ALL) {
- newctype = setlocale(LC_CTYPE, NULL);
- DEBUG_Lv(PerlIO_printf(Perl_debug_log,
- "%s:%d: %s\n", __FILE__, __LINE__,
- setlocale_debug_string(LC_CTYPE, NULL, newctype)));
- }
- else
+ switch (category) {
-# endif
+#ifdef USE_LOCALE_CTYPE
- newctype = retval;
- new_ctype(newctype);
- }
+ case LC_CTYPE:
+ new_ctype(retval);
+ break;
-#endif /* USE_LOCALE_CTYPE */
+#endif
#ifdef USE_LOCALE_COLLATE
- if ( category == LC_COLLATE
-
-# ifdef LC_ALL
-
- || category == LC_ALL
-
-# endif
-
- )
- {
- char *newcoll;
-
-# ifdef LC_ALL
-
- if (category == LC_ALL) {
- newcoll = setlocale(LC_COLLATE, NULL);
- DEBUG_Lv(PerlIO_printf(Perl_debug_log,
- "%s:%d: %s\n", __FILE__, __LINE__,
- setlocale_debug_string(LC_COLLATE, NULL, newcoll)));
- }
- else
-
-# endif
-
- newcoll = retval;
- new_collate(newcoll);
- }
+ case LC_COLLATE:
+ new_collate(retval);
+ break;
-#endif /* USE_LOCALE_COLLATE */
+#endif
#ifdef USE_LOCALE_NUMERIC
- if ( category == LC_NUMERIC
+ case LC_NUMERIC:
+ new_numeric(retval);
+ break;
-# ifdef LC_ALL
+#endif
+#ifdef LC_ALL
- || category == LC_ALL
+ case LC_ALL:
-# endif
+ /* LC_ALL updates all the things we care about. The values may not
+ * be the same as 'retval', as the locale "" may have set things
+ * individually */
- )
- {
- char *newnum;
+# ifdef USE_LOCALE_CTYPE
-# ifdef LC_ALL
+ newlocale = do_setlocale_c(LC_CTYPE, NULL);
+ new_ctype(newlocale);
- if (category == LC_ALL) {
- newnum = setlocale(LC_NUMERIC, NULL);
- DEBUG_Lv(PerlIO_printf(Perl_debug_log,
- "%s:%d: %s\n", __FILE__, __LINE__,
- setlocale_debug_string(LC_NUMERIC, NULL, newnum)));
- }
- else
+# endif /* USE_LOCALE_CTYPE */
+# ifdef USE_LOCALE_COLLATE
+
+ newlocale = do_setlocale_c(LC_COLLATE, NULL);
+ new_collate(newlocale);
# endif
+# ifdef USE_LOCALE_NUMERIC
- newnum = retval;
- new_numeric(newnum);
- }
+ newlocale = do_setlocale_c(LC_NUMERIC, NULL);
+ new_numeric(newlocale);
-#endif /* USE_LOCALE_NUMERIC */
+# endif /* USE_LOCALE_NUMERIC */
+#endif /* LC_ALL */
+ default:
+ break;
}
return retval;
if (toggle) {
if (item == PERL_RADIXCHAR || item == PERL_THOUSEP) {
- setlocale(LC_NUMERIC, PL_numeric_name);
+ do_setlocale_c(LC_NUMERIC, PL_numeric_name);
}
else {
toggle = FALSE;
save_to_buffer(nl_langinfo(item), &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
if (toggle) {
- setlocale(LC_NUMERIC, "C");
+ do_setlocale_c(LC_NUMERIC, "C");
}
LOCALE_UNLOCK;
LOCALE_LOCK;
if (toggle) {
- setlocale(LC_NUMERIC, PL_numeric_name);
+ do_setlocale_c(LC_NUMERIC, PL_numeric_name);
}
lc = localeconv();
save_to_buffer(retval, &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
if (toggle) {
- setlocale(LC_NUMERIC, "C");
+ do_setlocale_c(LC_NUMERIC, "C");
}
LOCALE_UNLOCK;
# ifdef LC_ALL
if (lang) {
- sl_result = my_setlocale(LC_ALL, setlocale_init);
+ sl_result = do_setlocale_c(LC_ALL, setlocale_init);
DEBUG_LOCALE_INIT(LC_ALL, setlocale_init, sl_result);
if (sl_result)
done = TRUE;
locale_param = (! done && (lang || PerlEnv_getenv("LC_CTYPE")))
? setlocale_init
: NULL;
- curctype = my_setlocale(LC_CTYPE, locale_param);
+ curctype = do_setlocale_c(LC_CTYPE, locale_param);
DEBUG_LOCALE_INIT(LC_CTYPE, locale_param, sl_result);
if (! curctype)
setlocale_failure = TRUE;
locale_param = (! done && (lang || PerlEnv_getenv("LC_COLLATE")))
? setlocale_init
: NULL;
- curcoll = my_setlocale(LC_COLLATE, locale_param);
+ curcoll = do_setlocale_c(LC_COLLATE, locale_param);
DEBUG_LOCALE_INIT(LC_COLLATE, locale_param, sl_result);
if (! curcoll)
setlocale_failure = TRUE;
locale_param = (! done && (lang || PerlEnv_getenv("LC_NUMERIC")))
? setlocale_init
: NULL;
- curnum = my_setlocale(LC_NUMERIC, locale_param);
+ curnum = do_setlocale_c(LC_NUMERIC, locale_param);
DEBUG_LOCALE_INIT(LC_NUMERIC, locale_param, sl_result);
if (! curnum)
setlocale_failure = TRUE;
locale_param = (! done && (lang || PerlEnv_getenv("LC_MESSAGES")))
? setlocale_init
: NULL;
- sl_result = my_setlocale(LC_MESSAGES, locale_param);
+ sl_result = do_setlocale_c(LC_MESSAGES, locale_param);
DEBUG_LOCALE_INIT(LC_MESSAGES, locale_param, sl_result);
if (! sl_result) {
setlocale_failure = TRUE;
locale_param = (! done && (lang || PerlEnv_getenv("LC_MONETARY")))
? setlocale_init
: NULL;
- sl_result = my_setlocale(LC_MONETARY, locale_param);
+ sl_result = do_setlocale_c(LC_MONETARY, locale_param);
DEBUG_LOCALE_INIT(LC_MONETARY, locale_param, sl_result);
if (! sl_result) {
setlocale_failure = TRUE;
/* Note that this may change the locale, but we are going to do
* that anyway just below */
- system_default_locale = setlocale(LC_ALL, "");
+ system_default_locale = do_setlocale_c(LC_ALL, "");
DEBUG_LOCALE_INIT(LC_ALL, "", system_default_locale);
/* Skip if invalid or if it's already on the list of locales to
# ifdef LC_ALL
- sl_result = my_setlocale(LC_ALL, trial_locale);
+ sl_result = do_setlocale_c(LC_ALL, trial_locale);
DEBUG_LOCALE_INIT(LC_ALL, trial_locale, sl_result);
if (! sl_result) {
setlocale_failure = TRUE;
# ifdef USE_LOCALE_CTYPE
Safefree(curctype);
- curctype = my_setlocale(LC_CTYPE, trial_locale);
+ curctype = do_setlocale_c(LC_CTYPE, trial_locale);
DEBUG_LOCALE_INIT(LC_CTYPE, trial_locale, curctype);
if (! curctype)
setlocale_failure = TRUE;
# ifdef USE_LOCALE_COLLATE
Safefree(curcoll);
- curcoll = my_setlocale(LC_COLLATE, trial_locale);
+ curcoll = do_setlocale_c(LC_COLLATE, trial_locale);
DEBUG_LOCALE_INIT(LC_COLLATE, trial_locale, curcoll);
if (! curcoll)
setlocale_failure = TRUE;
# ifdef USE_LOCALE_NUMERIC
Safefree(curnum);
- curnum = my_setlocale(LC_NUMERIC, trial_locale);
+ curnum = do_setlocale_c(LC_NUMERIC, trial_locale);
DEBUG_LOCALE_INIT(LC_NUMERIC, trial_locale, curnum);
if (! curnum)
setlocale_failure = TRUE;
# endif /* USE_LOCALE_NUMERIC */
# ifdef USE_LOCALE_MESSAGES
- sl_result = my_setlocale(LC_MESSAGES, trial_locale);
+ sl_result = do_setlocale_c(LC_MESSAGES, trial_locale);
DEBUG_LOCALE_INIT(LC_MESSAGES, trial_locale, sl_result);
if (! (sl_result))
setlocale_failure = TRUE;
# endif /* USE_LOCALE_MESSAGES */
# ifdef USE_LOCALE_MONETARY
- sl_result = my_setlocale(LC_MONETARY, trial_locale);
+ sl_result = do_setlocale_c(LC_MONETARY, trial_locale);
DEBUG_LOCALE_INIT(LC_MONETARY, trial_locale, sl_result);
if (! (sl_result))
setlocale_failure = TRUE;
# ifdef USE_LOCALE_CTYPE
Safefree(curctype);
- curctype = savepv(setlocale(LC_CTYPE, NULL));
+ curctype = savepv(do_setlocale_c(LC_CTYPE, NULL));
DEBUG_LOCALE_INIT(LC_CTYPE, NULL, curctype);
# endif /* USE_LOCALE_CTYPE */
# ifdef USE_LOCALE_COLLATE
Safefree(curcoll);
- curcoll = savepv(setlocale(LC_COLLATE, NULL));
+ curcoll = savepv(do_setlocale_c(LC_COLLATE, NULL));
DEBUG_LOCALE_INIT(LC_COLLATE, NULL, curcoll);
# endif /* USE_LOCALE_COLLATE */
# ifdef USE_LOCALE_NUMERIC
Safefree(curnum);
- curnum = savepv(setlocale(LC_NUMERIC, NULL));
+ curnum = savepv(do_setlocale_c(LC_NUMERIC, NULL));
DEBUG_LOCALE_INIT(LC_NUMERIC, NULL, curnum);
# endif /* USE_LOCALE_NUMERIC */
# endif
/* First dispose of the trivial cases */
- save_input_locale = setlocale(category, NULL);
+ save_input_locale = do_setlocale_r(category, NULL);
if (! save_input_locale) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not find current locale for category %d\n",
if (category != LC_CTYPE) { /* These work only on LC_CTYPE */
/* Get the current LC_CTYPE locale */
- save_ctype_locale = setlocale(LC_CTYPE, NULL);
+ save_ctype_locale = do_setlocale_c(LC_CTYPE, NULL);
if (! save_ctype_locale) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not find current locale for LC_CTYPE\n"));
Safefree(save_ctype_locale);
save_ctype_locale = NULL;
}
- else if (! setlocale(LC_CTYPE, save_input_locale)) {
+ else if (! do_setlocale_c(LC_CTYPE, save_input_locale)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not change LC_CTYPE locale to %s\n",
save_input_locale));
* should give the correct results */
# if defined(HAS_NL_LANGINFO) && defined(CODESET)
+ /* The task is easiest if has this POSIX 2001 function */
{
- char *codeset = nl_langinfo(CODESET);
- if (codeset && strNE(codeset, "")) {
- codeset = savepv(codeset);
+ const char *codeset = my_nl_langinfo(PERL_CODESET, FALSE);
+ /* FALSE => already in dest locale */
+ DEBUG_L(PerlIO_printf(Perl_debug_log,
+ "\tnllanginfo returned CODESET '%s'\n", codeset));
+
+ if (codeset && strNE(codeset, "")) {
/* If we switched LC_CTYPE, switch back */
if (save_ctype_locale) {
- setlocale(LC_CTYPE, save_ctype_locale);
+ do_setlocale_c(LC_CTYPE, save_ctype_locale);
Safefree(save_ctype_locale);
}
- is_utf8 = foldEQ(codeset, STR_WITH_LEN("UTF-8"))
- || foldEQ(codeset, STR_WITH_LEN("UTF8"));
+ is_utf8 = ( ( strlen(codeset) == STRLENs("UTF-8")
+ && foldEQ(codeset, STR_WITH_LEN("UTF-8")))
+ || ( strlen(codeset) == STRLENs("UTF8")
+ && foldEQ(codeset, STR_WITH_LEN("UTF8"))));
DEBUG_L(PerlIO_printf(Perl_debug_log,
"\tnllanginfo returned CODESET '%s'; ?UTF8 locale=%d\n",
codeset, is_utf8));
- Safefree(codeset);
Safefree(save_input_locale);
return is_utf8;
}
* result */
if (is_utf8) {
wchar_t wc;
+ int len;
+
PERL_UNUSED_RESULT(mbtowc(&wc, NULL, 0));/* Reset any shift state */
errno = 0;
- if ((size_t)mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8))
- != strlen(HYPHEN_UTF8)
- || wc != (wchar_t) 0x2010)
+ len = mbtowc(&wc, STR_WITH_LEN(REPLACEMENT_CHARACTER_UTF8));
+
+
+ if ( len != STRLENs(REPLACEMENT_CHARACTER_UTF8)
+ || wc != (wchar_t) 0xFFFD)
{
is_utf8 = FALSE;
- DEBUG_L(PerlIO_printf(Perl_debug_log, "\thyphen=U+%x\n", (unsigned int)wc));
+ DEBUG_L(PerlIO_printf(Perl_debug_log, "\replacement=U+%x\n",
+ (unsigned int)wc));
DEBUG_L(PerlIO_printf(Perl_debug_log,
"\treturn from mbtowc=%d; errno=%d; ?UTF8 locale=0\n",
- mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8)), errno));
+ len, errno));
}
}
/* If we switched LC_CTYPE, switch back */
if (save_ctype_locale) {
- setlocale(LC_CTYPE, save_ctype_locale);
+ do_setlocale_c(LC_CTYPE, save_ctype_locale);
Safefree(save_ctype_locale);
}
if (category != LC_MONETARY) {
- save_monetary_locale = setlocale(LC_MONETARY, NULL);
+ save_monetary_locale = do_setlocale_c(LC_MONETARY, NULL);
if (! save_monetary_locale) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not find current locale for LC_MONETARY\n"));
Safefree(save_monetary_locale);
save_monetary_locale = NULL;
}
- else if (! setlocale(LC_MONETARY, save_input_locale)) {
+ else if (! do_setlocale_c(LC_MONETARY, save_input_locale)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not change LC_MONETARY locale to %s\n",
save_input_locale));
/* If we changed it, restore LC_MONETARY to its original locale */
if (save_monetary_locale) {
- setlocale(LC_MONETARY, save_monetary_locale);
+ do_setlocale_c(LC_MONETARY, save_monetary_locale);
Safefree(save_monetary_locale);
}
if (category != LC_TIME) {
- save_time_locale = setlocale(LC_TIME, NULL);
+ save_time_locale = do_setlocale_c(LC_TIME, NULL);
if (! save_time_locale) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not find current locale for LC_TIME\n"));
Safefree(save_time_locale);
save_time_locale = NULL;
}
- else if (! setlocale(LC_TIME, save_input_locale)) {
+ else if (! do_setlocale_c(LC_TIME, save_input_locale)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not change LC_TIME locale to %s\n",
save_input_locale));
* false otherwise. But first, restore LC_TIME to its original
* locale if we changed it */
if (save_time_locale) {
- setlocale(LC_TIME, save_time_locale);
+ do_setlocale_c(LC_TIME, save_time_locale);
Safefree(save_time_locale);
}
* ASCII. Go on to the next test. If we changed it, restore LC_TIME
* to its original locale */
if (save_time_locale) {
- setlocale(LC_TIME, save_time_locale);
+ do_setlocale_c(LC_TIME, save_time_locale);
Safefree(save_time_locale);
}
DEBUG_L(PerlIO_printf(Perl_debug_log, "All time-related words for %s contain only ASCII; can't use for determining if UTF-8 locale\n", save_input_locale));
if (category != LC_MESSAGES) {
- save_messages_locale = setlocale(LC_MESSAGES, NULL);
+ save_messages_locale = do_setlocale_c(LC_MESSAGES, NULL);
if (! save_messages_locale) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not find current locale for LC_MESSAGES\n"));
Safefree(save_messages_locale);
save_messages_locale = NULL;
}
- else if (! setlocale(LC_MESSAGES, save_input_locale)) {
+ else if (! do_setlocale_c(LC_MESSAGES, save_input_locale)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"Could not change LC_MESSAGES locale to %s\n",
save_input_locale));
/* And, if we changed it, restore LC_MESSAGES to its original locale */
if (save_messages_locale) {
- setlocale(LC_MESSAGES, save_messages_locale);
+ do_setlocale_c(LC_MESSAGES, save_messages_locale);
Safefree(save_messages_locale);
}
while ((name += strcspn(name, "Uu") + 1)
<= save_input_locale + final_pos - 2)
{
- if ( !isALPHA_FOLD_NE(*name, 't')
+ if ( isALPHA_FOLD_NE(*name, 't')
|| isALPHA_FOLD_NE(*(name + 1), 'f'))
{
continue;
/* This function is trivial if we have strerror_l() */
if (within_locale_scope) {
- errstr = strerror(errnum);
+ errstr = savepv(strerror(errnum));
}
else {
- errstr = strerror_l(errnum, PL_C_locale_obj);
+ errstr = savepv(strerror_l(errnum, PL_C_locale_obj));
}
- errstr = savepv(errstr);
-
# else /* Doesn't have strerror_l(). */
# ifdef USE_POSIX_2008_LOCALE
# else /* Not thread-safe build */
- save_locale = setlocale(LC_MESSAGES, NULL);
+ save_locale = do_setlocale_c(LC_MESSAGES, NULL);
if (! save_locale) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"setlocale failed, errno=%d\n", errno));
/* The setlocale() just below likely will zap 'save_locale', so
* create a copy. */
save_locale = savepv(save_locale);
- setlocale(LC_MESSAGES, "C");
+ do_setlocale_c(LC_MESSAGES, "C");
}
}
# else
if (save_locale && ! locale_is_C) {
- if (! setlocale(LC_MESSAGES, save_locale)) {
+ if (! do_setlocale_c(LC_MESSAGES, save_locale)) {
DEBUG_L(PerlIO_printf(Perl_debug_log,
"setlocale restore failed, errno=%d\n", errno));
}
void
Perl_sync_locale(pTHX)
{
+ char * newlocale;
#ifdef USE_LOCALE_CTYPE
- new_ctype(setlocale(LC_CTYPE, NULL));
+ newlocale = do_setlocale_c(LC_CTYPE, NULL);
+ DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+ "%s:%d: %s\n", __FILE__, __LINE__,
+ setlocale_debug_string(LC_CTYPE, NULL, newlocale)));
+ new_ctype(newlocale);
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- new_collate(setlocale(LC_COLLATE, NULL));
+ newlocale = do_setlocale_c(LC_COLLATE, NULL);
+ DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+ "%s:%d: %s\n", __FILE__, __LINE__,
+ setlocale_debug_string(LC_COLLATE, NULL, newlocale)));
+ new_collate(newlocale);
#endif
#ifdef USE_LOCALE_NUMERIC
- set_numeric_local(); /* Switch from "C" to underlying LC_NUMERIC */
- new_numeric(setlocale(LC_NUMERIC, NULL));
+ newlocale = do_setlocale_c(LC_NUMERIC, NULL);
+ DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+ "%s:%d: %s\n", __FILE__, __LINE__,
+ setlocale_debug_string(LC_NUMERIC, NULL, newlocale)));
+ new_numeric(newlocale);
#endif /* USE_LOCALE_NUMERIC */
https://perl5.git.perl.org / perl5.git / blobdiff