From f6894bc8d44272e8edc3e1c3719989f1b171de3f Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 27 Jul 2012 10:11:25 -0700
Subject: [PATCH] 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 <nick@ccl4.org>
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.
---
 op.c       |  2 ++
 t/op/sub.t | 10 +++++++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

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
-- 
2.7.4