In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f6894bc8d44272e8edc3e1c3719989f1b171de3f?hp=d40eae8f110fb9900e82648a2c44710def9f117d>
- Log ----------------------------------------------------------------- commit f6894bc8d44272e8edc3e1c3719989f1b171de3f Author: Father Chrysostomos <[email protected]> Date: Fri Jul 27 10:11:25 2012 -0700 Fix CvGV assertion bug with sub redefinition *foo = \&baz; *bar = *foo; eval 'sub bar { print +(caller 0)[3], "\n" }'; bar(); Before 5.14, that produces: main::foo As of 5.14, it produces: main::baz Or, under debugging builds: Assertion failed: (CvGV(cv) == gv), function Perl_newATTRSUB_flags, file op.c, line 7139. commit 437388a93114b1acbfb3a173dfa7aa2138fd8283 Author: Nicholas Clark <[email protected]> Date: Thu Nov 18 14:54:44 2010 +0000 Refactor newATTRSUB()'s logic for grafting a sub definition to an existing stub Previously it was using cv_undef() to (partially) free the target CV (the pre-existing stub), before donating it the padlist and outside pointers from the source CV (the definition, just compiled), and then freeing up the remains of the source CV. Instead, explicitly exchange padlist and outside pointers, explicitly assign other fields that need changing (file and stash), and assert that various CvFLAGS are as we expect them. That commit adds some assertions, including: + assert(!CvCVGV_RC(cv)); + assert(CvGV(cv) == gv); Those assertions are not always true. CvGV might be refcounted, and it might not point to the same gv. 437388a93 also changed things such that the CVf_CVGV_RC flag is clob- bered, so refcounting and backrefs get out of synch (tests for that specific bug will be in a subsequent commit). It also stopped sub redefinition from setting CvGV. ----------------------------------------------------------------------- Summary of changes: op.c | 2 ++ t/op/sub.t | 10 +++++++++- 2 files changed, 11 insertions(+), 1 deletions(-) diff --git a/op.c b/op.c index c613290..578dbb3 100644 --- a/op.c +++ b/op.c @@ -7043,6 +7043,8 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP * const cvstart = CvSTART(cv); assert(!CvWEAKOUTSIDE(cv)); + + CvGV_set(cv,gv); assert(!CvCVGV_RC(cv)); assert(CvGV(cv) == gv); diff --git a/t/op/sub.t b/t/op/sub.t index b8e514d..6463e95 100644 --- a/t/op/sub.t +++ b/t/op/sub.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan( tests => 14 ); +plan( tests => 15 ); sub empty_sub {} @@ -64,3 +64,11 @@ is(scalar(@test), 0, 'Didnt return anything'); isnt \sub { ()=\@_; return shift }->($x), \$x, 'result of shift is copied when explicitly returned'; } + +fresh_perl_is + <<'end', "main::foo\n", {}, 'sub redefinition sets CvGV'; +*foo = \&baz; +*bar = *foo; +eval 'sub bar { print +(caller 0)[3], "\n" }'; +bar(); +end -- Perl5 Master Repository
