This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #123677] Crash with token stack overflow
authorFather Chrysostomos <sprout@cpan.org>
Mon, 9 Feb 2015 05:29:59 +0000 (21:29 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 9 Feb 2015 05:29:59 +0000 (21:29 -0800)
In this naughty code snippet:

s)$0{0h());qx(@0);qx(@0);qx(@0)

the s)...)) is treated as a substition, with $0{0h( for the left part.
When the lexer reaches the h( it tries to emit two tokens at once, '&'
and a WORD token representing the h.  To do that it pushes the WORD on
to the pending token stack and then emits '&'.  The next call to yylex
will usually pop the token off the pending stack and use that, because
the lexing state (PL_lex_state) is LEX_KNOWNEXT.

However, when the parser sees '&', it immediately reports it as
a syntax error, and tries to pop tokens to make sense of what it
has, popping scopes in the process.  Inside a quote-like operator,
PL_lex_state is localised, so the value after this scope-popping is
no longer LEX_KNOWNEXT, so the next call to yylex continues parsing
‘;qx...’ and ignores the pending token.

When it reaches the @0 inside the qx, it tries to push five pending
tokens on to the stack at once, because that’s how the implicit join
works.  But the stack only has room for five items.  Since it already
has one, the last item overflows, corrupting the parser state.
Crashes ensue.

If we check for the number of pending tokens and always emit any
regardless of the lexing state, then we avoid the crash.  This is
arguably how it should have been written to begin with.

This makes LEX_KNOWNEXT, and probably PL_lex_defer, redundant, but I
will wait till after perl 5.22 before removing those, as the removal
may break CPAN modules, and this is a little late in the dev cycle.

t/base/lex.t
toke.c

index 66db28b..5449b46 100644 (file)
@@ -488,3 +488,9 @@ print "ok $test - map{sub :lvalue...}\n"; $test++;
 
 # Used to fail an assertion [perl #123617]
 eval '"$a{ 1 m// }"; //';
+
+# Pending token stack overflow [perl #123677]
+{
+ local $SIG{__WARN__}=sub{};
+ eval q|s)$0{0h());qx(@0);qx(@0);qx(@0)|;
+}
diff --git a/toke.c b/toke.c
index 2df7732..24b5ed0 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4312,13 +4312,8 @@ Perl_yylex(pTHX)
        SvREFCNT_dec(tmp);
     } );
 
-    switch (PL_lex_state) {
-    case LEX_NORMAL:
-    case LEX_INTERPNORMAL:
-       break;
-
     /* when we've already built the next token, just pull it out of the queue */
-    case LEX_KNOWNEXT:
+    if (PL_nexttoke) {
        PL_nexttoke--;
        pl_yylval = PL_nextval[PL_nexttoke];
        if (!PL_nexttoke) {
@@ -4343,6 +4338,12 @@ Perl_yylex(pTHX)
            }
            return REPORT(next_type == 'p' ? pending_ident() : next_type);
        }
+    }
+
+    switch (PL_lex_state) {
+    case LEX_NORMAL:
+    case LEX_INTERPNORMAL:
+       break;
 
     /* interpolated case modifiers like \L \U, including \Q and \E.
        when we get here, PL_bufptr is at the \