CvOUTSIDE should be strong for lexsub declared in inner pack sub
authorFather Chrysostomos <sprout@cpan.org>
Tue, 4 Sep 2012 04:26:37 +0000 (21:26 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 16 Sep 2012 05:45:07 +0000 (22:45 -0700)
PadnameOUTER (SvFAKE) entries in pads of clonable subs contain the
offset in the parent pad where the closed-over entry is to be found.
The pad itself does not reference the outer lexical until the sub is
cloned at run time.

newMYSUB had to account for that by following CvOUTSIDE for
PadnameOUTER entries, to account for cases like this:

    my sub foo;
    my sub bar { sub foo {} }

The sub foo{} definition would have to find the my sub foo declaration
from outside and store the sub there.

That code was not accounting for named package subs, which close over
variables at compile time, so they don’t need (and don’t) store a par-
ent offset.

So outcv would point to bar in this case:

    my sub foo;
    sub bar { sub foo {} }

If outcv matched CvOUTSIDE(foo), then CvOUTSIDE was made weak.

That does not help in cases like this:

    undef *bar;
    {
        my sub foo;
        sub bar { sub foo {} }
    }

If foo has a weak CvOUTSIDE pointer, then it will still point to bar
after bar is freed, which does not help when the sub is cloned and
tries to look at CvROOT(CvOUTSIDE).

If the pad name is marked PadnameOUTER, even if it has no parent pad
index, newMYSUB needs to leave the CvOUTSIDE pointer strongc.

Also, pad_fixup_inner_anons did not account for subs with strong
CvOUTSIDE pointers whose CvOUTSIDE point to the sub whose pad is being
iterated through.

op.c
pad.c
t/cmd/lexsub.t

diff --git a/op.c b/op.c
index a21364d..6e5bd91 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7099,7 +7099,13 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        PL_compcv = NULL;
        goto done;
     }
-    if (outcv == CvOUTSIDE(compcv)) { 
+    /* Checking whether outcv is CvOUTSIDE(compcv) is not sufficient to
+       determine whether this sub definition is in the same scope as its
+       declaration.  If this sub definition is inside an inner named pack-
+       age sub (my sub foo; sub bar { sub foo { ... } }), outcv points to
+       the package sub.  So check PadnameOUTER(name) too.
+     */
+    if (outcv == CvOUTSIDE(compcv) && !PadnameOUTER(name)) { 
        assert(!CvWEAKOUTSIDE(compcv));
        SvREFCNT_dec(CvOUTSIDE(compcv));
        CvWEAKOUTSIDE_on(compcv);
diff --git a/pad.c b/pad.c
index 29ad4ad..f6c47f5 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -2218,7 +2218,10 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
                    : NULL;
            CV * const innercv = MUTABLE_CV(mg ? mg->mg_obj : curpad[ix]);
            if (CvOUTSIDE(innercv) == old_cv) {
-               assert(CvWEAKOUTSIDE(innercv));
+               if (!CvWEAKOUTSIDE(innercv)) {
+                   SvREFCNT_dec(old_cv);
+                   SvREFCNT_inc_simple_void_NN(new_cv);
+               }
                CvOUTSIDE(innercv) = new_cv;
            }
          }
index 293f70f..72ad6c7 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     *bar::like = *like;
 }
 no warnings 'deprecated';
-plan 111;
+plan 112;
 
 # -------------------- our -------------------- #
 
@@ -537,3 +537,10 @@ sub not_lexical5 {
 }
 is not_lexical4, 234,
     'my sub defined in predeclared pkg sub but declared outside';
+
+undef *not_lexical6;
+{
+  my sub foo;
+  sub not_lexical6 { sub foo { } }
+  pass 'no crash when cloning a mysub declared inside an undef pack sub';
+}