diff options
author | Father Chrysostomos <sprout@cpan.org> | 2015-02-04 22:11:06 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2015-02-05 09:15:16 -0800 |
commit | 67c71cbbd62a75ff2b913421806f6ea0f0b33558 (patch) | |
tree | e48b2d8f3a50e1d84c1eeef007d8e07c3e38a51f | |
parent | d9a13252ba5aad7b3eaaff069b56472cfb651a40 (diff) | |
download | perl-67c71cbbd62a75ff2b913421806f6ea0f0b33558.tar.gz |
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.
-rw-r--r-- | t/lib/croak/toke | 26 | ||||
-rw-r--r-- | toke.c | 5 |
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 @@ -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; } |