Stop eval "qq'\$\0foo'" from leaking

If the dollar sign in a double-quoted string is followed by a null,
then scan_ident gets confused, as it uses the nullness to keep track
of whether it has found an identifier.  In this case it treats $\0 as
a punctuation variable but then loses track of that fact and thinks it
has found the end of the string.

It’s complicated, but the end result is that the sequence of tokens
emitted for eval "qq'$\0foo'" would be the following:

    stringify ( $ . "foo" )

instead of this:

    stringify ( $ <ident> . "foo" )

But the missing identifier after the dollar sign results in a syn-
tax error that prevents yylex from having a chance to emit the
"foo", which by that time it has put on the forced token stack.

There are cases in which the CV that owns the ops on the forced token
stack can be freed while the ops are still on that stack and will
still be fed to the parser, so we treat the forced token stack like
the savestack, and do not allow ops thereon to be freed when their CV
is freed, to avoid feeding freed ops to the parser.

In this case, it means that the ops on the stack are never freed,
resulting in a memory leak.

Whether scan_ident needs to be fixed (or ‘fixed’) I don’t know.  I do
know that when the parser is freed any remaining forced tokens should
also be freed.  Even if this leak could be fixed some other way, it
would still be a good idea for parser_free to check for forced tokens
that need to be cleaned up.

1 files changed, 16 insertions, 0 deletions

diff --git a/toke.c b/toke.c
index 0d00d9eb71..f38381cb0a 100644
--- a/toke.c
+++ b/toke.c
@@ -773,6 +773,12 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
 void
 Perl_parser_free(pTHX_  const yy_parser *parser)
 {
+#ifdef PERL_MAD
+   I32 nexttoke = parser->lasttoke;
+#else
+   I32 nexttoke = parser->nexttoke;
+#endif
+
     PERL_ARGS_ASSERT_PARSER_FREE;
 
     PL_curcop = parser->saved_curcop;
@@ -786,6 +792,16 @@ Perl_parser_free(pTHX_  const yy_parser *parser)
     SvREFCNT_dec(parser->rsfp_filters);
     SvREFCNT_dec(parser->lex_stuff);
     SvREFCNT_dec(parser->sublex_info.repl);
+    while (nexttoke--) {
+#ifdef PERL_MAD
+	if (S_is_opval_token(parser->nexttoke[nexttoke].next_type
+				& 0xffff))
+	    op_free(parser->nexttoke[nexttoke].next_val.opval);
+#else
+	if (S_is_opval_token(parser->nexttype[nexttoke] & 0xffff))
+	    op_free(parser->nextval[nexttoke].opval);
+#endif
+    }
 
     Safefree(parser->lex_brackstack);
     Safefree(parser->lex_casestack);