[perl.git] branch blead, updated. v5.17.2-85-g2ba1f20

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 <sprout@cpan.org>
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 <sprout@cpan.org>
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 <davem@fdisolutions.com>
    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

• [perl.git] branch blead, updated. v5.17.2-85-g2ba1f20 by Father Chrysostomos