Fix double free with const overload after errors

The PL_lex_stuff variable in the parser struct is reference-counted.
Yet, in toke.c:S_sublex_start we pass the value to S_tokeq, which may
pass it to S_new_constant, which takes ownership of the reference
count (possibly freeing or mortalising the SV), and then relinquishes
its ownership of the returned SV (incrementing the reference count if
it is the same SV passed to it).  If S_new_constant croaks, then it
will have mortalised the SV passed to it while PL_lex_stuff still
points to it.

This example makes S_new_constant croak indirectly, by causing its
yyerror call to croak because of the number of errors:

$ perl5.20.1 -e 'BEGIN { $^H|=0x8000} undef(1,2); undef(1,2); undef(1,2); undef(1,2); undef(1,2); undef(1,2); undef(1,2); undef(1,2); undef(1,2); "a"'
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Too many arguments for undef operator at -e line 1, near "2)"
Constant(q) unknown at -e line 1, near ";"a""
-e has too many errors.
Attempt to free unreferenced scalar: SV 0x7fb49882fae8 at -e line 1.

2 files changed, 29 insertions, 2 deletions

diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index 26fc8c7b05..57f3790e2f 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -186,6 +186,32 @@ Constant(qq): Call to &{$^H{qr}} did not return a defined value at - line 3, wit
 Constant(q): Call to &{$^H{qr}} did not return a defined value at - line 3, within pattern
 Execution of - aborted due to compilation errors.
 ########
+# NAME Failed constant overloading should not cause a double free
+use overload;
+BEGIN { overload::constant q => sub {}; undef *^H }
+undef(1,2);
+undef(1,2);
+undef(1,2);
+undef(1,2);
+undef(1,2);
+undef(1,2);
+undef(1,2);
+undef(1,2);
+undef(1,2);
+"a"
+EXPECT
+Too many arguments for undef operator at - line 3, near "2)"
+Too many arguments for undef operator at - line 4, near "2)"
+Too many arguments for undef operator at - line 5, near "2)"
+Too many arguments for undef operator at - line 6, near "2)"
+Too many arguments for undef operator at - line 7, near "2)"
+Too many arguments for undef operator at - line 8, near "2)"
+Too many arguments for undef operator at - line 9, near "2)"
+Too many arguments for undef operator at - line 10, near "2)"
+Too many arguments for undef operator at - line 11, near "2)"
+Constant(q) unknown at - line 12, near ""a""
+- has too many errors.
+########
 # NAME Unterminated delimiter for here document
 <<"foo
 EXPECT
diff --git a/toke.c b/toke.c
index c0a5b3123f..b67ca0d60e 100644
--- a/toke.c
+++ b/toke.c
@@ -2276,7 +2276,9 @@ S_sublex_start(pTHX)
 	return THING;
     }
     if (op_type == OP_CONST) {
-	SV *sv = tokeq(PL_lex_stuff);
+	SV *sv = PL_lex_stuff;
+	PL_lex_stuff = NULL;
+	sv = tokeq(sv);
 
 	if (SvTYPE(sv) == SVt_PVIV) {
 	    /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
@@ -2287,7 +2289,6 @@ S_sublex_start(pTHX)
 	    sv = nsv;
 	}
 	pl_yylval.opval = (OP*)newSVOP(op_type, 0, sv);
-	PL_lex_stuff = NULL;
 	return THING;
     }