In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8faf4f305a9ccdf8b6fdbfccb769dbb73e6b6d25?hp=f0d9913136619e8b6716f2dfa6d8524a6df9e2c0>
- Log ----------------------------------------------------------------- commit 8faf4f305a9ccdf8b6fdbfccb769dbb73e6b6d25 Author: Hugo van der Sanden <[email protected]> Date: Wed Jan 4 14:52:21 2017 +0000 [perl #130495] /x comment skipping stops a byte short If that byte was part of a utf-8 character, this caused inappropriate "malformed utf8" warnings or assertions. In principle this should also skip the newline, but failing to do so is safe. ----------------------------------------------------------------------- Summary of changes: t/re/pat.t | 10 +++++++++- toke.c | 7 ++++++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/t/re/pat.t b/t/re/pat.t index b8d7680082..a72989f77b 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -23,7 +23,7 @@ BEGIN { skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader; skip_all_without_unicode_tables(); -plan tests => 827; # Update this when adding/deleting tests. +plan tests => 828; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1860,6 +1860,14 @@ EOF_CODE like($got[5],qr/Error: Infinite recursion via empty pattern/, "empty pattern in regex codeblock: produced the right exception message" ); } + { + # [perl #130495] /x comment skipping stopped a byte short, leading + # to assertion failure or 'malformed utf-8 character" warning + fresh_perl_is( + "use utf8; m{a#\x{124}}x", '', {}, + '[perl #130495] utf-8 character at end of /x comment should not misparse', + ); + } } # End of sub run_tests 1; diff --git a/toke.c b/toke.c index c5971c76ef..c0e3e273bf 100644 --- a/toke.c +++ b/toke.c @@ -3257,7 +3257,7 @@ S_scan_const(pTHX_ char *start) && !in_charclass && ((PMOP*)PL_lex_inpat)->op_pmflags & RXf_PMf_EXTENDED) { - while (s+1 < send && *s != '\n') + while (s < send && *s != '\n') *d++ = *s++; } @@ -3298,6 +3298,11 @@ S_scan_const(pTHX_ char *start) /* End of else if chain - OP_TRANS rejoin rest */ + if (UNLIKELY(s >= send)) { + assert(s == send); + break; + } + /* backslashes */ if (*s == '\\' && s+1 < send) { char* e; /* Can be used for ending '}', etc. */ -- Perl5 Master Repository
