From 6a642c21192e08a710804b462f8c97902797d5b4 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Thu, 7 Nov 2013 05:33:24 -0800 Subject: [PATCH] Make _charnames comparison null-safe MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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. --- t/re/pat_advanced.t | 10 ++++++++++ toke.c | 3 ++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index d7ef8e9..6329683 100644 --- 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 --- 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; } } -- 2.7.4