In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/ebcc725e3f7e5ec8b898a7035ff5c5e2c230522e?hp=6e8135a4380966ca56b30d95854b54dc8d9c08d4>
- Log ----------------------------------------------------------------- commit ebcc725e3f7e5ec8b898a7035ff5c5e2c230522e Author: Tony Cook <[email protected]> Date: Thu Oct 19 10:47:22 2017 +1100 (perl #132245) don't leak on \N{} get_and_check_backslash_N_name() failed to free its working SV if the name was empty. commit e8d55f27af460b2aea0e4f6867acad7ae6e154cc Author: Tony Cook <[email protected]> Date: Thu Oct 19 10:46:04 2017 +1100 (perl #132245) don't try to process a char range with no preceding char A range like \N{}-0 eventually results in compilation failing, but before that, get_and_check_backslash_N_name() attempts to treat the memory before the empty output of \N{} as a character. ----------------------------------------------------------------------- Summary of changes: t/lib/croak/toke | 6 ++++++ t/op/svleak.t | 7 ++++++- toke.c | 7 ++++--- 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/t/lib/croak/toke b/t/lib/croak/toke index 87d958020a..1a7468faf5 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -413,3 +413,9 @@ EXPECT Illegal operator following parameter in a subroutine signature at - line 3, near "($a += 1" syntax error at - line 3, near "($a += 1" Execution of - aborted due to compilation errors. +######## +# NAME tr/// range with empty \N{} at the start +tr//\N{}-0/; +EXPECT +Unknown charname '' at - line 1, within string +Execution of - aborted due to compilation errors. diff --git a/t/op/svleak.t b/t/op/svleak.t index e4e881d11c..7226dd878c 100644 --- a/t/op/svleak.t +++ b/t/op/svleak.t @@ -15,7 +15,7 @@ BEGIN { use Config; -plan tests => 141; +plan tests => 142; # run some code N times. If the number of SVs at the end of loop N is # greater than (N-1)*delta at the end of loop 1, we've got a leak @@ -593,3 +593,8 @@ EOF } ::leak(2, 0, \&named, "Perl_reg_named_buff_fetch() on no-name RE"); } + +{ + sub N_leak { eval 'tr//\N{}-0/' } + ::leak(2, 0, \&N_leak, "a bad \\N{} in a range leaks"); +} diff --git a/toke.c b/toke.c index e7208babec..a8578e6975 100644 --- a/toke.c +++ b/toke.c @@ -2595,6 +2595,7 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME; if (!SvCUR(res)) { + SvREFCNT_dec_NN(res); /* diag_listed_as: Unknown charname '%s' */ yyerror("Unknown charname ''"); return NULL; @@ -2969,9 +2970,9 @@ S_scan_const(pTHX_ char *start) /* Here, we don't think we're in a range. If the new character * is not a hyphen; or if it is a hyphen, but it's too close to - * either edge to indicate a range, then it's a regular - * character. */ - if (*s != '-' || s >= send - 1 || s == start) { + * either edge to indicate a range, or if we haven't output any + * characters yet then it's a regular character. */ + if (*s != '-' || s >= send - 1 || s == start || d == SvPVX(sv)) { /* A regular character. Process like any other, but first * clear any flags */ -- Perl5 Master Repository
