sv_setpv(PL_numeric_radix_sv, lc->decimal_point);
else
PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0);
- if (! is_invariant_string((U8 *) lc->decimal_point, 0)
+ if (! is_utf8_invariant_string((U8 *) lc->decimal_point, 0)
&& is_utf8_string((U8 *) lc->decimal_point, 0)
&& _is_cur_LC_category_utf8(LC_NUMERIC))
{
: NULL;
sl_result = my_setlocale(LC_MESSAGES, locale_param);
DEBUG_LOCALE_INIT(LC_MESSAGES, locale_param, sl_result);
- if (! sl_result)
+ if (! sl_result) {
setlocale_failure = TRUE;
}
# endif /* USE_LOCALE_MESSAGES */
* This will give as good as possible results on strings that don't
* otherwise contain that character, but otherwise there may be
* less-than-perfect results with that character and NUL. This is
- * unavoidable unless we replace strxfrm with our own implementation.
- *
- * This is one of the few places in the perl core, where we can use
- * standard functions like strlen() and strcat(). It's because we're
- * looking for NULs. */
+ * unavoidable unless we replace strxfrm with our own implementation. */
if (s_strlen < len) {
char * e = s + len;
char * sans_nuls;
STRLEN cur_min_char_len;
+ STRLEN sans_nuls_len;
+ STRLEN sans_nuls_pos;
int try_non_controls;
/* If we don't know what control character sorts lowest for this
* character in it is NUL. Multiply that by the length of each
* replacement, and allow for a trailing NUL */
cur_min_char_len = strlen(PL_strxfrm_min_char);
- Newx(sans_nuls, (len * cur_min_char_len) + 1, char);
+ sans_nuls_len = (len * cur_min_char_len) + 1;
+ Newx(sans_nuls, sans_nuls_len, char);
*sans_nuls = '\0';
+ sans_nuls_pos = 0;
/* Replace each NUL with the lowest collating control. Loop until have
* exhausted all the NULs */
while (s + s_strlen < e) {
- strcat(sans_nuls, s);
+ sans_nuls_pos = my_strlcat(sans_nuls + sans_nuls_pos,
+ s,
+ sans_nuls_len);
/* Do the actual replacement */
- strcat(sans_nuls, PL_strxfrm_min_char);
+ sans_nuls_pos = my_strlcat(sans_nuls + sans_nuls_pos,
+ PL_strxfrm_min_char,
+ sans_nuls_len);
/* Move past the input NUL */
s += s_strlen + 1;
}
/* And add anything that trails the final NUL */
- strcat(sans_nuls, s);
+ my_strlcat(sans_nuls + sans_nuls_pos, s, sans_nuls_len);
/* Switch so below we transform this modified string */
s = sans_nuls;
lc = localeconv();
if (! lc
|| ! lc->currency_symbol
- || is_invariant_string((U8 *) lc->currency_symbol, 0))
+ || is_utf8_invariant_string((U8 *) lc->currency_symbol, 0))
{
DEBUG_L(PerlIO_printf(Perl_debug_log, "Couldn't get currency symbol for %s, or contains only ASCII; can't use for determining if UTF-8 locale\n", save_input_locale));
only_ascii = TRUE;
for (i = 0; i < 7 + 12; i++) { /* 7 days; 12 months */
formatted_time = my_strftime("%A %B %Z %p",
0, 0, hour, dom, month, 112, 0, 0, is_dst);
- if (! formatted_time || is_invariant_string((U8 *) formatted_time, 0)) {
+ if ( ! formatted_time
+ || is_utf8_invariant_string((U8 *) formatted_time, 0))
+ {
/* Here, we didn't find a non-ASCII. Try the next time through
* with the complemented dst and am/pm, and try with the next
break;
}
errmsg = savepv(errmsg);
- if (! is_invariant_string((U8 *) errmsg, 0)) {
+ if (! is_utf8_invariant_string((U8 *) errmsg, 0)) {
non_ascii = TRUE;
is_utf8 = is_utf8_string((U8 *) errmsg, 0);
break;
locale_t save_locale;
# else
char * save_locale;
- bool locale_is_C;
+ bool locale_is_C = FALSE;
/* We have a critical section to prevent another thread from changing the
* locale out from under us (or zapping the buffer returned from
# endif
if (! within_locale_scope) {
+ errno = 0;
# ifdef USE_THREAD_SAFE_LOCALE /* Use the thread-safe locale functions */
save_locale = uselocale(PL_C_locale_obj);
+ if (! save_locale) {
+ DEBUG_L(PerlIO_printf(Perl_debug_log,
+ "uselocale failed, errno=%d\n", errno));
+ }
# else /* Not thread-safe build */
save_locale = setlocale(LC_MESSAGES, NULL);
- locale_is_C = isNAME_C_OR_POSIX(save_locale);
+ if (! save_locale) {
+ DEBUG_L(PerlIO_printf(Perl_debug_log,
+ "setlocale failed, errno=%d\n", errno));
+ }
+ else {
+ locale_is_C = isNAME_C_OR_POSIX(save_locale);
- /* Switch to the C locale if not already in it */
- if (! locale_is_C) {
+ /* Switch to the C locale if not already in it */
+ if (! locale_is_C) {
- /* The setlocale() just below likely will zap 'save_locale', so
- * create a copy. */
- save_locale = savepv(save_locale);
- setlocale(LC_MESSAGES, "C");
+ /* The setlocale() just below likely will zap 'save_locale', so
+ * create a copy. */
+ save_locale = savepv(save_locale);
+ setlocale(LC_MESSAGES, "C");
+ }
}
# endif
#ifdef USE_LOCALE_MESSAGES
if (! within_locale_scope) {
+ errno = 0;
# ifdef USE_THREAD_SAFE_LOCALE
- uselocale(save_locale);
+ if (save_locale && ! uselocale(save_locale)) {
+ DEBUG_L(PerlIO_printf(Perl_debug_log,
+ "uselocale restore failed, errno=%d\n", errno));
+ }
}
# else
- if (! locale_is_C) {
- setlocale(LC_MESSAGES, save_locale);
+ if (save_locale && ! locale_is_C) {
+ if (! setlocale(LC_MESSAGES, save_locale)) {
+ DEBUG_L(PerlIO_printf(Perl_debug_log,
+ "setlocale restore failed, errno=%d\n", errno));
+ }
Safefree(save_locale);
}
}