This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Prevent double frees/crashes with format syntax errs
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index ef41fef..4fc3f43 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -314,8 +314,7 @@ enum token_type {
     TOKENTYPE_IVAL,
     TOKENTYPE_OPNUM, /* pl_yylval.ival contains an opcode number */
     TOKENTYPE_PVAL,
-    TOKENTYPE_OPVAL,
-    TOKENTYPE_GVVAL
+    TOKENTYPE_OPVAL
 };
 
 static struct debug_tokens {
@@ -431,7 +430,6 @@ S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp)
            Perl_sv_catpvf(aTHX_ report, "?? %"IVdf, (IV)rv);
        switch (type) {
        case TOKENTYPE_NONE:
-       case TOKENTYPE_GVVAL: /* doesn't appear to be used */
            break;
        case TOKENTYPE_IVAL:
            Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)lvalp->ival);
@@ -1988,6 +1986,11 @@ 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);
@@ -4480,6 +4483,8 @@ 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 */
 #ifdef PERL_MAD
            /* FIXME - can these be merged?  */
            return next_type;