In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2ba1f20ac3ac18b441a222cea2b0bbf6f3588c7d?hp=f6894bc8d44272e8edc3e1c3719989f1b171de3f>
- Log ----------------------------------------------------------------- commit 2ba1f20ac3ac18b441a222cea2b0bbf6f3588c7d Author: Father Chrysostomos <[email protected]> Date: Fri Jul 27 10:46:26 2012 -0700 [perl #113684] Document actual prec of loop exits These have always* had assignment precedence, such that $a = goto $b = $c is equivalent to $a = (goto ($b = $c)) * I havenât checked before perl 5. M pod/perlcheat.pod M pod/perlfunc.pod M pod/perlop.pod commit e52de15a297bcbe6fac509aef6b35095923fa7d0 Author: Father Chrysostomos <[email protected]> Date: Fri Jul 27 10:30:58 2012 -0700 Fix CvOUTSIDE assert/refcnt bugs with sub redefinition my $sub = sub { 4 }; *foo = $sub; *bar = *foo; undef &$sub; eval "sub bar { 3 }"; undef *foo; undef *bar; As of 5.8.4, this script produces: Attempt to free unreferenced scalar: SV 0x8002c4. As of 5.14.0: panic: del_backref. Or, undef debugging builds: Assertion failed: (!CvWEAKOUTSIDE(cv)), function Perl_newATTRSUB_flags, file op.c, line 7045. Commit 5c41a5fa918 (backported to 5.8.4 in commit 7a565e5d) caused the first bug: commit 5c41a5fa918d32924e1ac2f02418d5d7f465ef26 Author: Dave Mitchell <[email protected]> Date: Sun Jan 25 02:04:23 2004 +0000 Remove small memory leak in newATTRSUB that manifested as a leaking scalar after the interpeter was cloned p4raw-id: //depot/perl@22209 diff --git a/op.c b/op.c index b902fed..5fd21bf 100644 --- a/op.c +++ b/op.c @@ -4165,6 +4165,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) /* transfer PL_compcv to cv */ cv_undef(cv); CvFLAGS(cv) = CvFLAGS(PL_compcv); + if (!CvWEAKOUTSIDE(cv)) + SvREFCNT_dec(CvOUTSIDE(cv)); CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv); CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv); CvOUTSIDE(PL_compcv) = 0; Checking the flags right after clobbering them canât be a good idea. Commit 437388a93 caused the panics and assertion failures. See com- mit f6894bc for detail. Commit f6894bc fixed the panics and assertion failures involving CvGV. One remaining assertion (!CvWEAKOUTSIDE) added by 437388a93 is still incorrect. Itâs not true that CvWEAKOUTSIDE is never set on a re- used stub. In both cases (5c41a5faâs code and 437388a93âs code), the weakness of CvOUTSIDE is ignored and the outside sub (the eval) is freed prematurely. It could be that this type of redefinition should be disallowed (des- pite its usefulness), but that is a separate issue. This used to work. And pure-Perl code should not be triggering assertion failures or freeing scalars twice. M op.c M t/op/sub.t ----------------------------------------------------------------------- Summary of changes: op.c | 9 ++++----- pod/perlcheat.pod | 2 +- pod/perlfunc.pod | 25 +++++++++++++++++++++++++ pod/perlop.pod | 2 +- t/op/sub.t | 15 ++++++++++++++- 5 files changed, 45 insertions(+), 8 deletions(-) diff --git a/op.c b/op.c index 578dbb3..276dbd8 100644 --- a/op.c +++ b/op.c @@ -7039,11 +7039,10 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS; AV *const temp_av = CvPADLIST(cv); CV *const temp_cv = CvOUTSIDE(cv); - const cv_flags_t slabbed = CvSLABBED(cv); + const cv_flags_t other_flags = + CvFLAGS(cv) & (CVf_SLABBED|CVf_WEAKOUTSIDE); OP * const cvstart = CvSTART(cv); - assert(!CvWEAKOUTSIDE(cv)); - CvGV_set(cv,gv); assert(!CvCVGV_RC(cv)); assert(CvGV(cv) == gv); @@ -7057,8 +7056,8 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, CvPADLIST(PL_compcv) = temp_av; CvSTART(cv) = CvSTART(PL_compcv); CvSTART(PL_compcv) = cvstart; - if (slabbed) CvSLABBED_on(PL_compcv); - else CvSLABBED_off(PL_compcv); + CvFLAGS(PL_compcv) &= ~(CVf_SLABBED|CVf_WEAKOUTSIDE); + CvFLAGS(PL_compcv) |= other_flags; if (CvFILE(cv) && CvDYNFILE(cv)) { Safefree(CvFILE(cv)); diff --git a/pod/perlcheat.pod b/pod/perlcheat.pod index 7fd82f8..f288692 100644 --- a/pod/perlcheat.pod +++ b/pod/perlcheat.pod @@ -42,7 +42,7 @@ already be overwhelming. || // /m line based ^$ $ str end (bfr \n) .. ... /s . includes \n + one or more ?: /x ignore wh.space * zero or more - = += -= *= etc /p preserve ? zero or one + = += last goto /p preserve ? zero or one , => /a ASCII /aa safe {3,7} repeat in range list ops /l locale /d dual | alternation not /u Unicode [] character class diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 8e8bcca..b1cc605 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -1620,6 +1620,11 @@ convert a core file into an executable. That's why you should now invoke it as C<CORE::dump()>, if you don't want to be warned against a possible typo. +Unlike most named operators, this has the same precedence as assignment. +It is also exempt from the looks-like-a-function rule, so +C<dump ("foo")."bar"> will cause "bar" to be part of the argument to +C<dump>. + Portability issues: L<perlport/dump>. =item each HASH @@ -2917,6 +2922,11 @@ NAME needn't be the name of a subroutine; it can be a scalar variable containing a code reference or a block that evaluates to a code reference. +Unlike most named operators, this has the same precedence as assignment. +It is also exempt from the looks-like-a-function rule, so +C<goto ("foo")."bar"> will cause "bar" to be part of the argument to +C<goto>. + =item grep BLOCK LIST X<grep> @@ -3237,6 +3247,11 @@ exit out of such a block. See also L</continue> for an illustration of how C<last>, C<next>, and C<redo> work. +Unlike most named operators, this has the same precedence as assignment. +It is also exempt from the looks-like-a-function rule, so +C<last ("foo")."bar"> will cause "bar" to be part of the argument to +C<last>. + =item lc EXPR X<lc> X<lowercase> @@ -3754,6 +3769,11 @@ that executes once. Thus C<next> will exit such a block early. See also L</continue> for an illustration of how C<last>, C<next>, and C<redo> work. +Unlike most named operators, this has the same precedence as assignment. +It is also exempt from the looks-like-a-function rule, so +C<next ("foo")."bar"> will cause "bar" to be part of the argument to +C<next>. + =item no MODULE VERSION LIST X<no declarations> X<unimporting> @@ -5568,6 +5588,11 @@ turn it into a looping construct. See also L</continue> for an illustration of how C<last>, C<next>, and C<redo> work. +Unlike most named operators, this has the same precedence as assignment. +It is also exempt from the looks-like-a-function rule, so +C<redo ("foo")."bar"> will cause "bar" to be part of the argument to +C<redo>. + =item ref EXPR X<ref> X<reference> diff --git a/pod/perlop.pod b/pod/perlop.pod index bde763c..b7a1c7b 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -48,7 +48,7 @@ values only, not array values. left || // nonassoc .. ... right ?: - right = += -= *= etc. + right = += -= *= etc. goto last next redo dump left , => nonassoc list operators (rightward) right not diff --git a/t/op/sub.t b/t/op/sub.t index 6463e95..c4121df 100644 --- a/t/op/sub.t +++ b/t/op/sub.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan( tests => 15 ); +plan( tests => 16 ); sub empty_sub {} @@ -72,3 +72,16 @@ fresh_perl_is eval 'sub bar { print +(caller 0)[3], "\n" }'; bar(); end + +fresh_perl_is + <<'end', "main::foo\nok\n", {}, 'no double free redefining anon stub'; +my $sub = sub { 4 }; +*foo = $sub; +*bar = *foo; +undef &$sub; +eval 'sub bar { print +(caller 0)[3], "\n" }'; +&$sub; +undef *foo; +undef *bar; +print "ok\n"; +end -- Perl5 Master Repository
