diff options
-rw-r--r-- | embed.fnc | 4 | ||||
-rw-r--r-- | embed.h | 1 | ||||
-rw-r--r-- | pad.c | 2 | ||||
-rw-r--r-- | proto.h | 6 | ||||
-rw-r--r-- | t/op/svleak.t | 5 | ||||
-rw-r--r-- | toke.c | 52 |
6 files changed, 44 insertions, 26 deletions
@@ -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 @@ -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) @@ -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; @@ -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 @@ -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); } |