In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/743e3e72117ab1d168cbf4ef15bcde67ca41e26a?hp=bab2353254d7670be3a83e4e63b0a5b0e412b6e1>
- Log ----------------------------------------------------------------- commit 743e3e72117ab1d168cbf4ef15bcde67ca41e26a Author: Tony Cook <[email protected]> Date: Thu Sep 8 13:21:02 2016 +1000 (perl #129190) intuit_method() can move the line buffer and broke PL_bufptr when it did. ----------------------------------------------------------------------- Summary of changes: t/op/lex.t | 5 ++++- toke.c | 10 +++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/t/op/lex.t b/t/op/lex.t index c8ecf36cf2..7a05ee98c1 100644 --- a/t/op/lex.t +++ b/t/op/lex.t @@ -7,7 +7,7 @@ use warnings; BEGIN { chdir 't' if -d 't'; require './test.pl'; } -plan(tests => 35); +plan(tests => 36); { no warnings 'deprecated'; @@ -285,3 +285,6 @@ EOM {}, "[perl #129273] heap use after free or overflow" ); + +fresh_perl_like('flock _$', qr/Not enough arguments for flock/, {stderr => 1}, + "[perl #129190] intuit_method() invalidates PL_bufptr"); diff --git a/toke.c b/toke.c index ca06b7a3ab..0e02fd51cf 100644 --- a/toke.c +++ b/toke.c @@ -4276,13 +4276,14 @@ S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv) } if (*start == '$') { + SSize_t start_off = start - SvPVX(PL_linestr); if (cv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY || isUPPER(*PL_tokenbuf)) return 0; /* this could be $# */ if (isSPACE(*s)) s = skipspace(s); - PL_bufptr = start; + PL_bufptr = SvPVX(PL_linestr) + start_off; PL_expect = XREF; return *s == '(' ? FUNCMETH : METHOD; } @@ -7262,17 +7263,24 @@ Perl_yylex(pTHX) == OA_FILEREF)) { bool immediate_paren = *s == '('; + SSize_t s_off; /* (Now we can afford to cross potential line boundary.) */ s = skipspace(s); + /* intuit_method() can indirectly call lex_next_chunk(), + * invalidating s + */ + s_off = s - SvPVX(PL_linestr); /* Two barewords in a row may indicate method call. */ if ( ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) || *s == '$') && (tmp = intuit_method(s, lex ? NULL : sv, cv))) { + /* the code at method: doesn't use s */ goto method; } + s = SvPVX(PL_linestr) + s_off; /* If not a declared subroutine, it's an indirect object. */ /* (But it's an indir obj regardless for sort.) */ -- Perl5 Master Repository
