sv_setpv(PL_numeric_radix_sv, lc->decimal_point);
else
PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0);
- if (! is_ascii_string((U8 *) lc->decimal_point, 0)
+ if (! is_invariant_string((U8 *) lc->decimal_point, 0)
&& is_utf8_string((U8 *) lc->decimal_point, 0)
&& _is_cur_LC_category_utf8(LC_NUMERIC))
{
Copy(PL_fold_latin1, PL_fold_locale, 256, U8);
}
else {
+ /* Assume enough space for every character being bad. 4 spaces each
+ * for the 94 printable characters that are output like "'x' "; and 5
+ * spaces each for "'\\' ", "'\t' ", and "'\n' "; plus a terminating
+ * NUL */
+ char bad_chars_list[ (94 * 4) + (3 * 5) + 1 ];
+
+ bool check_for_problems = ckWARN_d(WARN_LOCALE); /* No warnings means
+ no check */
+ bool multi_byte_locale = FALSE; /* Assume is a single-byte locale
+ to start */
+ unsigned int bad_count = 0; /* Count of bad characters */
+
for (i = 0; i < 256; i++) {
if (isUPPER_LC((U8) i))
PL_fold_locale[i] = (U8) toLOWER_LC((U8) i);
PL_fold_locale[i] = (U8) toUPPER_LC((U8) i);
else
PL_fold_locale[i] = (U8) i;
+
+ /* If checking for locale problems, see if the native ASCII-range
+ * printables plus \n and \t are in their expected categories in
+ * the new locale. If not, this could mean big trouble, upending
+ * Perl's and most programs' assumptions, like having a
+ * metacharacter with special meaning become a \w. Fortunately,
+ * it's very rare to find locales that aren't supersets of ASCII
+ * nowadays. It isn't a problem for most controls to be changed
+ * into something else; we check only \n and \t, though perhaps \r
+ * could be an issue as well. */
+ if (check_for_problems
+ && (isGRAPH_A(i) || isBLANK_A(i) || i == '\n'))
+ {
+ if ((isALPHANUMERIC_A(i) && ! isALPHANUMERIC_LC(i))
+ || (isPUNCT_A(i) && ! isPUNCT_LC(i))
+ || (isBLANK_A(i) && ! isBLANK_LC(i))
+ || (i == '\n' && ! isCNTRL_LC(i)))
+ {
+ if (bad_count) { /* Separate multiple entries with a
+ blank */
+ bad_chars_list[bad_count++] = ' ';
+ }
+ bad_chars_list[bad_count++] = '\'';
+ if (isPRINT_A(i)) {
+ bad_chars_list[bad_count++] = (char) i;
+ }
+ else {
+ bad_chars_list[bad_count++] = '\\';
+ if (i == '\n') {
+ bad_chars_list[bad_count++] = 'n';
+ }
+ else {
+ assert(i == '\t');
+ bad_chars_list[bad_count++] = 't';
+ }
+ }
+ bad_chars_list[bad_count++] = '\'';
+ bad_chars_list[bad_count] = '\0';
+ }
+ }
+ }
+
+#ifdef MB_CUR_MAX
+ /* We only handle single-byte locales (outside of UTF-8 ones; so if
+ * this locale requires than one byte, there are going to be
+ * problems. */
+ if (check_for_problems && MB_CUR_MAX > 1) {
+ multi_byte_locale = TRUE;
+ }
+#endif
+
+ if (bad_count || multi_byte_locale) {
+
+ /* We have to save 'newctype' because the setlocale() just below
+ * may destroy it. The next setlocale() further down should
+ * restore it properly so that the intermediate change here is
+ * transparent to this function's caller */
+ const char * const badlocale = savepv(newctype);
+
+ setlocale(LC_CTYPE, "C");
+ Perl_warner(aTHX_ packWARN(WARN_LOCALE),
+ "Locale '%s' may not work well.%s%s%s\n",
+ badlocale,
+ (multi_byte_locale)
+ ? " Some characters in it are not recognized by"
+ " Perl."
+ : "",
+ (bad_count)
+ ? "\nThe following characters (and maybe others)"
+ " may not have the same meaning as the Perl"
+ " program expects:\n"
+ : "",
+ (bad_count)
+ ? bad_chars_list
+ : ""
+ );
+ setlocale(LC_CTYPE, badlocale);
}
}
|| wc != (wchar_t) 0x2010)
{
is_utf8 = FALSE;
- DEBUG_L(PerlIO_printf(Perl_debug_log, "\thyphen=U+%x\n", wc));
+ DEBUG_L(PerlIO_printf(Perl_debug_log, "\thyphen=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));
lc = localeconv();
if (! lc
|| ! lc->currency_symbol
- || is_ascii_string((U8 *) lc->currency_symbol, 0))
+ || is_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;
/* Here the current LC_TIME is set to the locale of the category
* whose information is desired. Look at all the days of the week and
- * month names, and the timezone and am/pm indicator for non-ASCII
+ * month names, and the timezone and am/pm indicator for UTF-8 variant
* characters. The first such a one found will tell us if the locale
* is UTF-8 or not */
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_ascii_string((U8 *) formatted_time, 0)) {
+ if (! formatted_time || is_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_ascii_string((U8 *) errmsg, 0)) {
+ if (! is_invariant_string((U8 *) errmsg, 0)) {
non_ascii = TRUE;
is_utf8 = is_utf8_string((U8 *) errmsg, 0);
break;
https://perl5.git.perl.org / perl5.git / blobdiff