#28315 could crash when freeing ops with different pads

Add hook to parser to record current PL_comppad, then use this
when popping ops off the parser stack after parser error

p4raw-id: //depot/perl@29501

1 files changed, 31 insertions, 25 deletions

diff --git a/perly.y b/perly.y
index af62341bba..ad0e604543 100644
--- a/perly.y
+++ b/perly.y
@@ -48,6 +48,7 @@
     char *pval;
     OP *opval;
     GV *gvval;
+    AV* padval;
 #ifdef PERL_IN_MADLY_C
     TOKEN* p_tkval;
     TOKEN* i_tkval;
@@ -91,6 +92,7 @@
 %type <opval> termbinop termunop anonymous termdo
 %type <opval> switch case
 %type <p_tkval> label
+%type <padval> remempad
 
 %nonassoc <i_tkval> PREC_LOW
 %nonassoc LOOPEX
@@ -502,15 +504,15 @@ peg	:	PEG
 			}
 	;
 
-format	:	FORMAT startformsub formname block
+format	:	FORMAT remempad startformsub formname block
 			{ SvREFCNT_inc(PL_compcv);
 #ifdef MAD
-			  $$ = newFORM($2, $3, $4);
+			  $$ = newFORM($3, $4, $5);
 			  prepend_madprops($1->tk_mad, $$, 'F');
 			  $1->tk_mad = 0;
 			  token_free($1);
 #else
-			  newFORM($2, $3, $4);
+			  newFORM($3, $4, $5);
 #endif
 			}
 	;
@@ -520,38 +522,42 @@ formname:	WORD		{ $$ = $1; }
 	;
 
 /* Unimplemented "my sub foo { }" */
-mysubrout:	MYSUB startsub subname proto subattrlist subbody
+mysubrout:	MYSUB remempad startsub subname proto subattrlist subbody
 			{ SvREFCNT_inc(PL_compcv);
 #ifdef MAD
-			  $$ = newMYSUB($2, $3, $4, $5, $6);
+			  $$ = newMYSUB($3, $4, $5, $6, $7);
 			  token_getmad($1,$$,'d');
 #else
-			  newMYSUB($2, $3, $4, $5, $6);
+			  newMYSUB($3, $4, $5, $6, $7);
 #endif
 			}
 	;
 
 /* Subroutine definition */
-subrout	:	SUB startsub subname proto subattrlist subbody
+subrout	:	SUB remempad startsub subname proto subattrlist subbody
 			{ SvREFCNT_inc(PL_compcv);
 #ifdef MAD
 			  OP* o = newSVOP(OP_ANONCODE, 0,
-			    (SV*)newATTRSUB($2, $3, $4, $5, $6));
+			    (SV*)newATTRSUB($3, $4, $5, $6, $7));
 			  $$ = newOP(OP_NULL,0);
 			  op_getmad(o,$$,'&');
-			  op_getmad($3,$$,'n');
-			  op_getmad($4,$$,'s');
-			  op_getmad($5,$$,'a');
+			  op_getmad($4,$$,'n');
+			  op_getmad($5,$$,'s');
+			  op_getmad($6,$$,'a');
 			  token_getmad($1,$$,'d');
-			  append_madprops($6->op_madprop, $$, 0);
-			  $6->op_madprop = 0;
+			  append_madprops($7->op_madprop, $$, 0);
+			  $7->op_madprop = 0;
 #else
-			  newATTRSUB($2, $3, $4, $5, $6);
+			  newATTRSUB($3, $4, $5, $6, $7);
 			  $$ = Nullop;
 #endif
 			}
 	;
 
+remempad:	/* NULL */	/* remember current value of PL_comppad */
+			{ $$ = PL_comppad; }
+	;
+
 startsub:	/* NULL */	/* start a regular subroutine scope */
 			{ $$ = start_subparse(FALSE, 0);
 			    SAVEFREESV(PL_compcv); }
@@ -636,18 +642,18 @@ package :	PACKAGE WORD ';'
 			}
 	;
 
-use	:	USE startsub
+use	:	USE remempad startsub
 			{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
 		    WORD WORD listexpr ';'
 			{ SvREFCNT_inc(PL_compcv);
 #ifdef MAD
-			  $$ = utilize(IVAL($1), $2, $4, $5, $6);
+			  $$ = utilize(IVAL($1), $3, $5, $6, $7);
 			  token_getmad($1,$$,'o');
-			  token_getmad($7,$$,';');
+			  token_getmad($8,$$,';');
 			  if (PL_rsfp_filters && AvFILLp(PL_rsfp_filters) >= 0)
 			      append_madprops(newMADPROP('!', MAD_PV, "", 0), $$, 0);
 #else
-			  utilize(IVAL($1), $2, $4, $5, $6);
+			  utilize(IVAL($1), $3, $5, $6, $7);
 #endif
 			}
 	;
@@ -742,13 +748,13 @@ listop	:	LSTOP indirob argexpr /* map {...} @args or print $fh @args */
 			  TOKEN_GETMAD($2,$$,'(');
 			  TOKEN_GETMAD($4,$$,')');
 			}
-	|	LSTOPSUB startanonsub block /* sub f(&@);   f { foo } ... */
+	|	LSTOPSUB remempad startanonsub block /* sub f(&@); f {foo} ... */
 			{ SvREFCNT_inc(PL_compcv);
-			  $3 = newANONATTRSUB($2, 0, Nullop, $3); }
+			  $4 = newANONATTRSUB($3, 0, Nullop, $4); }
 		    listexpr		%prec LSTOP  /* ... @bar */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				 append_elem(OP_LIST,
-				   prepend_elem(OP_LIST, $3, $5), $1));
+				   prepend_elem(OP_LIST, $4, $6), $1));
 			}
 	;
 
@@ -996,12 +1002,12 @@ anonymous:	'[' expr ']'
 			  TOKEN_GETMAD($2,$$,';');
 			  TOKEN_GETMAD($3,$$,'}');
 			}
-	|	ANONSUB startanonsub proto subattrlist block	%prec '('
+	|	ANONSUB remempad startanonsub proto subattrlist block %prec '('
 			{ SvREFCNT_inc(PL_compcv);
-			  $$ = newANONATTRSUB($2, $3, $4, $5);
+			  $$ = newANONATTRSUB($3, $4, $5, $6);
 			  TOKEN_GETMAD($1,$$,'o');
-			  OP_GETMAD($3,$$,'s');
-			  OP_GETMAD($4,$$,'a');
+			  OP_GETMAD($4,$$,'s');
+			  OP_GETMAD($5,$$,'a');
 			}
 
     ;