Make _charnames comparison null-safe

This comparison in toke.c checks whether the charnames translators is
the core’s own and, if so, skips certain validation checks.

Charnames translators coming from any package beginning with
"_charnames\0" would also be exempt from the checks, because the name
comparison stopped at the first null.

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index d7ef8e9..6329683 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -1083,6 +1083,16 @@ sub run_tests {
             like ($@, qr/Trailing white-space in a charnames alias definition is deprecated/, "... same under utf8");
         }
 
+        {
+            BEGIN { no strict; *CnameTest:: = *{"_charnames\0A::" } }
+            package CnameTest { sub translator { pop } }
+            BEGIN { $^H{charnames} = \&CnameTest::translator }
+            undef $w;
+            () = eval q ["\N{TOO  MANY SPACES}"];
+            like ($w, qr/A sequence of multiple spaces/,
+                 'translators in _charnames\0* packages get validated');
+        }
+
         # If remove the limitation in regcomp code these should work
         # differently
         undef $w;

diff --git a/toke.c b/toke.c
index d7de0db..d871fc4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2859,7 +2859,8 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
         SvTYPE(rv) == SVt_PVCV) && ((stash = CvSTASH(rv)) != NULL))
     {
         const char * const name = HvNAME(stash);
-        if strEQ(name, "_charnames") {
+        if (HvNAMELEN(stash) == sizeof("_charnames")-1
+         && strEQ(name, "_charnames")) {
            return res;
        }
     }