#if defined(USE_LOCALE_NUMERIC) && ( defined(HAS_LOCALECONV) \
|| defined(HAS_NL_LANGINFO))
- /* 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, ".")) {
- const U8 * first_variant;
-
- if (PL_numeric_radix_sv) {
- sv_setpv(PL_numeric_radix_sv, radix);
- }
- else {
- PL_numeric_radix_sv = newSVpv(radix, 0);
- }
-
- /* If there is a byte variant under UTF-8, and if the remainder of
- * the string starting there is valid UTF-8, and we are in a UTF-8
- * locale, then mark the radix as being in UTF-8 */
- if ( ! is_utf8_invariant_string_loc(
- (U8 *) SvPVX(PL_numeric_radix_sv),
- SvCUR(PL_numeric_radix_sv),
- &first_variant)
- && is_utf8_string(first_variant,
- SvCUR(PL_numeric_radix_sv)
- - ((char *) first_variant
- - SvPVX(PL_numeric_radix_sv)))
- && _is_cur_LC_category_utf8(LC_NUMERIC))
- {
- SvUTF8_on(PL_numeric_radix_sv);
- }
- goto done;
- }
+ const char * radix = (use_locale)
+ ? my_nl_langinfo(PERL_RADIXCHAR, FALSE)
+ /* FALSE => already in dest locale */
+ : ".";
+
+ sv_setpv(PL_numeric_radix_sv, radix);
+
+ /* If this is valid UTF-8 that isn't totally ASCII, and we are in
+ * a UTF-8 locale, then mark the radix as being in UTF-8 */
+ if (is_utf8_non_invariant_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);
}
- 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",
- (PL_numeric_radix_sv)
- ? SvPVX(PL_numeric_radix_sv)
- : "NULL",
- (PL_numeric_radix_sv)
- ? cBOOL(SvUTF8(PL_numeric_radix_sv))
- : 0);
+ SvPVX(PL_numeric_radix_sv),
+ cBOOL(SvUTF8(PL_numeric_radix_sv)));
}
# endif
PL_numeric_underlying_is_standard = PL_numeric_standard;
+# if defined(HAS_NEWLOCALE) && ! defined(NO_POSIX_2008_LOCALE)
+
+ PL_underlying_numeric_obj = newlocale(LC_NUMERIC_MASK,
+ PL_numeric_name,
+ PL_underlying_numeric_obj);
+
+#endif
+
if (DEBUG_L_TEST || debug_initialization) {
PerlIO_printf(Perl_debug_log, "Called new_numeric with %s, PL_numeric_name=%s\n", newnum, PL_numeric_name);
}
* switching back, as some systems destroy the buffer when setlocale() is
* called */
- LOCALE_LOCK;
+ {
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
- if (toggle) {
- do_setlocale_c(LC_NUMERIC, PL_numeric_name);
- }
+ if (toggle) {
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
+ }
- save_to_buffer(nl_langinfo(item), &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
+ LOCALE_LOCK; /* Prevent interference from another thread executing
+ this code section (the only call to nl_langinfo in
+ the core) */
- if (toggle) {
- do_setlocale_c(LC_NUMERIC, "C");
- }
+ save_to_buffer(nl_langinfo(item), &PL_langinfo_buf,
+ &PL_langinfo_bufsize, 0);
- LOCALE_UNLOCK;
+ LOCALE_UNLOCK;
+
+ if (toggle) {
+ RESTORE_LC_NUMERIC();
+ }
+ }
# else /* Use nl_langinfo_l(), avoiding both a mutex and changing the locale */
{
- bool do_free = FALSE;
- locale_t cur = uselocale((locale_t) 0);
+ bool do_free = FALSE;
+ locale_t cur = uselocale((locale_t) 0);
- if (cur == LC_GLOBAL_LOCALE) {
- cur = duplocale(LC_GLOBAL_LOCALE);
- do_free = TRUE;
- }
+ if (cur == LC_GLOBAL_LOCALE) {
+ cur = duplocale(LC_GLOBAL_LOCALE);
+ do_free = TRUE;
+ }
- if (toggle) {
- cur = newlocale(LC_NUMERIC_MASK, PL_numeric_name, cur);
- do_free = TRUE;
- }
+ if (toggle) {
+ if (PL_underlying_numeric_obj) {
+ cur = PL_underlying_numeric_obj;
+ }
+ else {
+ cur = newlocale(LC_NUMERIC_MASK, PL_numeric_name, cur);
+ do_free = TRUE;
+ }
+ }
- save_to_buffer(nl_langinfo_l(item, cur),
- &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
- if (do_free) {
- freelocale(cur);
- }
+ save_to_buffer(nl_langinfo_l(item, cur),
+ &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
+ if (do_free) {
+ freelocale(cur);
+ }
}
# endif
# ifdef HAS_LOCALECONV
const struct lconv* lc;
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
# endif
# ifdef HAS_STRFTIME
case PERL_CRNCYSTR:
- LOCALE_LOCK;
-
/* 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() */
+
lc = localeconv();
if ( ! lc
|| ! lc->currency_symbol
case PERL_RADIXCHAR:
case PERL_THOUSEP:
- LOCALE_LOCK;
-
if (toggle) {
- do_setlocale_c(LC_NUMERIC, PL_numeric_name);
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
}
+ LOCALE_LOCK; /* Prevent interference with other threads
+ using localeconv() */
+
lc = localeconv();
if (! lc) {
retval = "";
save_to_buffer(retval, &PL_langinfo_buf,
&PL_langinfo_bufsize, 0);
+ LOCALE_UNLOCK;
+
if (toggle) {
- do_setlocale_c(LC_NUMERIC, "C");
+ RESTORE_LC_NUMERIC();
}
- LOCALE_UNLOCK;
-
break;
# endif
my_strlcpy(PL_locale_utf8ness, C_and_POSIX_utf8ness,
sizeof(PL_locale_utf8ness));
+ PL_numeric_radix_sv = newSVpvs(".");
+
# ifdef LOCALE_ENVIRON_REQUIRED
/*
save_input_locale = do_setlocale_r(category, NULL);
if (! save_input_locale) {
Perl_croak(aTHX_
- "panic: %s: %d: Could not find current locale for %s\n",
- __FILE__, __LINE__, category_name(category));
+ "panic: %s: %d: Could not find current %s locale, errno=%d\n",
+ __FILE__, __LINE__, category_name(category), errno);
}
save_input_locale = stdize_locale(savepv(save_input_locale));
/* Get the current LC_CTYPE locale */
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"));
- goto cant_use_nllanginfo;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not find current LC_CTYPE locale,"
+ " errno=%d\n", __FILE__, __LINE__, errno);
}
save_ctype_locale = stdize_locale(savepv(save_ctype_locale));
save_ctype_locale = NULL;
}
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));
Safefree(save_ctype_locale);
- goto cant_use_nllanginfo;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not change LC_CTYPE locale to %s,"
+ " errno=%d\n", __FILE__, __LINE__, save_input_locale, errno);
}
}
}
- cant_use_nllanginfo:
-
# else /* nl_langinfo should work if available, so don't bother compiling this
fallback code. The final fallback of looking at the name is
compiled, and will be executed if nl_langinfo fails */
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"));
- goto cant_use_monetary;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not find current LC_MONETARY locale,"
+ " errno=%d\n", __FILE__, __LINE__, errno);
}
save_monetary_locale = stdize_locale(savepv(save_monetary_locale));
save_monetary_locale = NULL;
}
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));
Safefree(save_monetary_locale);
- goto cant_use_monetary;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not change LC_MONETARY locale to %s,"
+ " errno=%d\n", __FILE__, __LINE__, save_input_locale, errno);
}
}
goto finish_and_return;
}
}
- cant_use_monetary:
# endif /* USE_LOCALE_MONETARY */
# endif /* HAS_LOCALECONV */
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"));
- goto cant_use_time;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not find current LC_TIME locale,"
+ " errno=%d\n", __FILE__, __LINE__, errno);
}
save_time_locale = stdize_locale(savepv(save_time_locale));
save_time_locale = NULL;
}
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));
Safefree(save_time_locale);
- goto cant_use_time;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not change LC_TIME locale to %s,"
+ " errno=%d\n", __FILE__, __LINE__, save_input_locale, errno);
}
}
}
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));
}
- cant_use_time:
# endif
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"));
- goto cant_use_messages;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not find current LC_MESSAGES locale,"
+ " errno=%d\n", __FILE__, __LINE__, errno);
}
save_messages_locale = stdize_locale(savepv(save_messages_locale));
save_messages_locale = NULL;
}
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));
Safefree(save_messages_locale);
- goto cant_use_messages;
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not change LC_MESSAGES locale to %s,"
+ " errno=%d\n", __FILE__, __LINE__, save_input_locale, errno);
}
}
DEBUG_L(PerlIO_printf(Perl_debug_log, "All error messages for %s contain only ASCII; can't use for determining if UTF-8 locale\n", save_input_locale));
}
- cant_use_messages:
# endif
# endif /* the code that is compiled when no nl_langinfo */
save_locale = do_setlocale_c(LC_MESSAGES, NULL);
if (! save_locale) {
- DEBUG_L(PerlIO_printf(Perl_debug_log,
- "setlocale failed, errno=%d\n", errno));
+ Perl_croak(aTHX_
+ "panic: %s: %d: Could not find current LC_MESSAGES locale,"
+ " errno=%d\n", __FILE__, __LINE__, errno);
}
else {
locale_is_C = isNAME_C_OR_POSIX(save_locale);
if (save_locale && ! locale_is_C) {
if (! do_setlocale_c(LC_MESSAGES, save_locale)) {
- DEBUG_L(PerlIO_printf(Perl_debug_log,
- "setlocale restore failed, errno=%d\n", errno));
+ Perl_croak(aTHX_
+ "panic: %s: %d: setlocale restore failed, errno=%d\n",
+ __FILE__, __LINE__, errno);
}
Safefree(save_locale);
}
https://perl5.git.perl.org / perl5.git / blobdiff