This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In cv_clone, use pad ID to identify mysub outside
authorFather Chrysostomos <sprout@cpan.org>
Tue, 4 Sep 2012 17:24:57 +0000 (10:24 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 16 Sep 2012 05:45:07 +0000 (22:45 -0700)
This code prints ARRAY(0x802e10), whereas it should print
SCALAR(0xfedbee):

undef &bar;
eval 'sub bar { my @x }';
{
  my sub foo;
  foo();
  sub bar {
    CORE::state $x;
    sub foo { warn \$x }
  }
}

The foo sub has a strong CvOUTSIDE pointer, but what it points to
can still be undefined and redefined.  So we need to identify it
by its pad.

pad.c
t/cmd/lexsub.t

diff --git a/pad.c b/pad.c
index f6c47f5..454d842 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1980,8 +1980,14 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
       if (SvTYPE(proto) == SVt_PVCV)
       {
        outside = find_runcv(NULL);
-       if (!CvANON(proto) && CvROOT(outside) != CvROOT(CvOUTSIDE(proto)))
-           outside = CvOUTSIDE(proto);
+       if (!CvANON(proto)) {
+           if (!CvPADLIST(outside) ||
+               CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid)
+               outside = CvOUTSIDE(proto);
+           if (!CvPADLIST(outside) ||
+               CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid)
+               outside = NULL;
+       }
       }
       else {
        outside = CvOUTSIDE(proto);
@@ -1998,7 +2004,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     depth = outside ? CvDEPTH(outside) : 0;
     if (!depth)
        depth = 1;
-    assert(SvTYPE(proto) == SVt_PVFM || CvPADLIST(outside));
 
     ENTER;
     SAVESPTR(PL_compcv);
@@ -2019,7 +2024,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     outpad = outside && CvPADLIST(outside)
        ? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth])
        : NULL;
-    assert(outpad || SvTYPE(cv) == SVt_PVFM);
     if (outpad) CvPADLIST(cv)->xpadl_outid = CvPADLIST(outside)->xpadl_id;
 
     for (ix = fpad; ix > 0; ix--) {
index 72ad6c7..02ebac7 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     *bar::like = *like;
 }
 no warnings 'deprecated';
-plan 112;
+plan 113;
 
 # -------------------- our -------------------- #
 
@@ -544,3 +544,17 @@ undef *not_lexical6;
   sub not_lexical6 { sub foo { } }
   pass 'no crash when cloning a mysub declared inside an undef pack sub';
 }
+
+undef &not_lexical7;
+eval 'sub not_lexical7 { my @x }';
+{
+  my sub foo;
+  foo();
+  sub not_lexical7 {
+    state $x;
+    sub foo {
+      is ref \$x, 'SCALAR',
+        "redeffing a mysub's outside does not make it use the wrong pad"
+    }
+  }
+}