Improve heuristic for UTF-8 detection in "$!"
authorKarl Williamson <khw@cpan.org>
Fri, 18 Aug 2017 19:46:25 +0000 (13:46 -0600)
committerKarl Williamson <khw@cpan.org>
Fri, 18 Aug 2017 20:35:48 +0000 (14:35 -0600)
Previously, the stringification of "$!" was considered to be UTF-8 if it
had any characters with the high bit set, and everything was
syntactically legal UTF-8.  This may to correctly guess on short strings
where there are only a few non-ASCII bytes.  This could happen in
languages based on the Latin script where many words don't use
non-ASCII.

This commit adds a check that the locale is a UTF-8 one.  That check is
a call to an already-existing subroutine which goes to some lengths to
get an accurate answer, and should be essentially completely reliable on
modern systems that have nl_langinfo() and/or mbtowc().

See the thread starting at
http://nntp.perl.org/group/perl.perl5.porters/245902

embed.fnc
embed.h
mg.c
proto.h

index 00efda9..b68484b 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2737,8 +2737,10 @@ snR      |char * |setlocale_debug_string |const int category                 \
 #   endif
 #endif
 
-#if     defined(USE_LOCALE) \
-    && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX))
+#if        defined(USE_LOCALE)         \
+    && (   defined(PERL_IN_LOCALE_C)   \
+        || defined(PERL_IN_MG_C)       \
+       || defined (PERL_EXT_POSIX))
 ApM    |bool   |_is_cur_LC_category_utf8|int category
 #endif
 
diff --git a/embed.h b/embed.h
index 3765648..9d2d1b2 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define sv_dup(a,b)            Perl_sv_dup(aTHX_ a,b)
 #define sv_dup_inc(a,b)                Perl_sv_dup_inc(aTHX_ a,b)
 #endif
-#if defined(USE_LOCALE)     && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX))
+#if defined(USE_LOCALE)                    && (   defined(PERL_IN_LOCALE_C)            || defined(PERL_IN_MG_C)                || defined (PERL_EXT_POSIX))
 #define _is_cur_LC_category_utf8(a)    Perl__is_cur_LC_category_utf8(aTHX_ a)
 #endif
 #if defined(USE_LOCALE_COLLATE)
diff --git a/mg.c b/mg.c
index 3b341d5..3d08df6 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -787,12 +787,24 @@ S_fixup_errno_string(pTHX_ SV* sv)
          * UTF-8 validity test"
          * (http://en.wikipedia.org/wiki/Charset_detection).  There is a
          * potential that we will get it wrong however, especially on short
-         * error message text.  (If it turns out to be necessary, we could also
-         * keep track if the current LC_MESSAGES locale is UTF-8) */
-        if (! IN_BYTES  /* respect 'use bytes' */
+         * error message text, so do an additional check. */
+        if (   ! IN_BYTES  /* respect 'use bytes' */
             && ! is_utf8_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv))
-            && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
-        {
+            &&   is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv))
+
+#ifdef USE_LOCALE_MESSAGES
+
+            &&   _is_cur_LC_category_utf8(LC_MESSAGES)
+
+#elif defined(USE_LOCLAE_CTYPE)
+
+                 /* For systems that don't have a separate message category,
+                  * this assumes that they follow the CTYPE one */
+            &&   _is_cur_LC_category_utf8(LC_CTYPE)
+
+#endif
+
+        ) {
             SvUTF8_on(sv);
         }
     }
diff --git a/proto.h b/proto.h
index f3f2250..b8a09df 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6051,7 +6051,7 @@ PERL_CALLCONV SV* Perl_sv_dup_inc(pTHX_ const SV *const sstr, CLONE_PARAMS *cons
        assert(param)
 
 #endif
-#if defined(USE_LOCALE)     && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX))
+#if defined(USE_LOCALE)                    && (   defined(PERL_IN_LOCALE_C)            || defined(PERL_IN_MG_C)                || defined (PERL_EXT_POSIX))
 PERL_CALLCONV bool     Perl__is_cur_LC_category_utf8(pTHX_ int category);
 #endif
 #if defined(USE_LOCALE) && defined(PERL_IN_LOCALE_C)