summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc4
-rw-r--r--embed.h1
-rw-r--r--pad.c2
-rw-r--r--proto.h6
-rw-r--r--t/op/svleak.t5
-rw-r--r--toke.c52
6 files changed, 44 insertions, 26 deletions
diff --git a/embed.fnc b/embed.fnc
index 3eb0084543..d4982b8421 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1547,6 +1547,10 @@ p |void |yyunlex
p |int |yyparse |int gramtype
: Only used in scope.c
p |void |parser_free |NN const yy_parser *parser
+#ifdef PERL_CORE
+p |void |parser_free_nexttoke_ops|NN yy_parser *parser \
+ |NN OPSLAB *slab
+#endif
#if defined(PERL_IN_TOKE_C)
s |int |yywarn |NN const char *const s|U32 flags
#endif
diff --git a/embed.h b/embed.h
index aaff3f7cf5..b8ad138179 100644
--- a/embed.h
+++ b/embed.h
@@ -1310,6 +1310,7 @@
#define opslab_force_free(a) Perl_opslab_force_free(aTHX_ a)
#define opslab_free(a) Perl_opslab_free(aTHX_ a)
#define opslab_free_nopad(a) Perl_opslab_free_nopad(aTHX_ a)
+#define parser_free_nexttoke_ops(a,b) Perl_parser_free_nexttoke_ops(aTHX_ a,b)
# if defined(PERL_DEBUG_READONLY_OPS)
#define Slab_to_ro(a) Perl_Slab_to_ro(aTHX_ a)
#define Slab_to_rw(a) Perl_Slab_to_rw(aTHX_ a)
diff --git a/pad.c b/pad.c
index cc34ade378..12d23b077d 100644
--- a/pad.c
+++ b/pad.c
@@ -370,6 +370,8 @@ Perl_cv_undef(pTHX_ CV *cv)
PAD_SAVE_SETNULLPAD();
/* discard any leaked ops */
+ if (PL_parser)
+ parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(cv));
opslab_force_free((OPSLAB *)CvSTART(cv));
CvSTART(cv) = NULL;
diff --git a/proto.h b/proto.h
index 14d512b745..5bb335217c 100644
--- a/proto.h
+++ b/proto.h
@@ -5261,6 +5261,12 @@ PERL_CALLCONV void Perl_opslab_free_nopad(pTHX_ OPSLAB *slab)
#define PERL_ARGS_ASSERT_OPSLAB_FREE_NOPAD \
assert(slab)
+PERL_CALLCONV void Perl_parser_free_nexttoke_ops(pTHX_ yy_parser *parser, OPSLAB *slab)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_PARSER_FREE_NEXTTOKE_OPS \
+ assert(parser); assert(slab)
+
# if defined(PERL_DEBUG_READONLY_OPS)
PERL_CALLCONV void Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
__attribute__nonnull__(pTHX_1);
diff --git a/t/op/svleak.t b/t/op/svleak.t
index c365709f73..d38c92d11f 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -218,10 +218,7 @@ eleak(2, 0, 'no warnings; 2 2;BEGIN{}',
'implicit "use Errno" after syntax error');
}
eleak(2, 0, "\"\$\0\356\"", 'qq containing $ <null> something');
-{
- local $::TODO = 'eval "END blah blah" still leaks';
- eleak(2, 0, 'END OF TERMS AND CONDITIONS', 'END followed by words');
-}
+eleak(2, 0, 'END OF TERMS AND CONDITIONS', 'END followed by words');
# [perl #114764] Attributes leak scalars
diff --git a/toke.c b/toke.c
index 6027af3f6a..cac14b9869 100644
--- a/toke.c
+++ b/toke.c
@@ -773,12 +773,6 @@ 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;
@@ -792,22 +786,43 @@ Perl_parser_free(pTHX_ const yy_parser *parser)
SvREFCNT_dec(parser->rsfp_filters);
SvREFCNT_dec(parser->lex_stuff);
SvREFCNT_dec(parser->sublex_info.repl);
+
+ Safefree(parser->lex_brackstack);
+ Safefree(parser->lex_casestack);
+ Safefree(parser->lex_shared);
+ PL_parser = parser->old_parser;
+ Safefree(parser);
+}
+
+void
+Perl_parser_free_nexttoke_ops(pTHX_ yy_parser *parser, OPSLAB *slab)
+{
+#ifdef PERL_MAD
+ I32 nexttoke = parser->lasttoke;
+#else
+ I32 nexttoke = parser->nexttoke;
+#endif
+ PERL_ARGS_ASSERT_PARSER_FREE_NEXTTOKE_OPS;
while (nexttoke--) {
#ifdef PERL_MAD
if (S_is_opval_token(parser->nexttoke[nexttoke].next_type
- & 0xffff))
- op_free(parser->nexttoke[nexttoke].next_val.opval);
+ & 0xffff)
+ && parser->nexttoke[nexttoke].next_val.opval
+ && parser->nexttoke[nexttoke].next_val.opval->op_slabbed
+ && OpSLAB(parser->nexttoke[nexttoke].next_val.opval) == slab) {
+ op_free(parser->nexttoke[nexttoke].next_val.opval);
+ parser->nexttoke[nexttoke].next_val.opval = NULL;
+ }
#else
- if (S_is_opval_token(parser->nexttype[nexttoke] & 0xffff))
+ if (S_is_opval_token(parser->nexttype[nexttoke] & 0xffff)
+ && parser->nextval[nexttoke].opval
+ && parser->nextval[nexttoke].opval->op_slabbed
+ && OpSLAB(parser->nextval[nexttoke].opval) == slab) {
op_free(parser->nextval[nexttoke].opval);
+ parser->nextval[nexttoke].opval = NULL;
+ }
#endif
}
-
- Safefree(parser->lex_brackstack);
- Safefree(parser->lex_casestack);
- Safefree(parser->lex_shared);
- PL_parser = parser->old_parser;
- Safefree(parser);
}
@@ -2023,11 +2038,6 @@ S_force_next(pTHX_ I32 type)
tokereport(type, &NEXTVAL_NEXTTOKE);
}
#endif
- /* Don’t let opslab_force_free snatch it */
- if (S_is_opval_token(type & 0xffff) && NEXTVAL_NEXTTOKE.opval) {
- assert(!NEXTVAL_NEXTTOKE.opval->op_savefree);
- NEXTVAL_NEXTTOKE.opval->op_savefree = 1;
- }
#ifdef PERL_MAD
if (PL_curforce < 0)
start_force(PL_lasttoke);
@@ -4653,8 +4663,6 @@ Perl_yylex(pTHX)
PL_lex_allbrackets--;
next_type &= 0xffff;
}
- if (S_is_opval_token(next_type) && pl_yylval.opval)
- pl_yylval.opval->op_savefree = 0; /* release */
return REPORT(next_type == 'p' ? pending_ident() : next_type);
}