Use the right outside for my subs defined in inner subs

In this example,

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

the foo sub is cloned when the scope containing the ‘my sub’ declara-
tion is entered, but foo’s CvOUTSIDE pointer points to something other
than the active sub.  cv_clone assumes that the currently-running sub
is the right sub to close over (at least for subs; formats are another
matter).  That was true in the absence of my subs.  This commit
changes it to account.

I had to tweak the test, which was wrong, because sub foo was closing
over a stale var.

2 files changed, 11 insertions, 12 deletions

diff --git a/pad.c b/pad.c
index 941f66382b..29ad4ad8dd 100644
--- a/pad.c
+++ b/pad.c
@@ -1963,15 +1963,14 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
     SV** outpad;
     long depth;
     bool subclones = FALSE;
-#ifdef DEBUGGING
-    CV * const outside_arg = outside;
-#endif
 
     assert(!CvUNIQUE(proto));
 
     /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
      * reliable.  The currently-running sub is always the one we need to
      * close over.
+     * For my subs, the currently-running sub may not be the one we want.
+     * We have to check whether it is a clone of CvOUTSIDE.
      * Note that in general for formats, CvOUTSIDE != find_runcv.
      * Since formats may be nested inside closures, CvOUTSIDE may point
      * to a prototype; we instead want the cloned parent who called us.
@@ -1979,7 +1978,11 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
 
     if (!outside) {
       if (SvTYPE(proto) == SVt_PVCV)
+      {
 	outside = find_runcv(NULL);
+	if (!CvANON(proto) && CvROOT(outside) != CvROOT(CvOUTSIDE(proto)))
+	    outside = CvOUTSIDE(proto);
+      }
       else {
 	outside = CvOUTSIDE(proto);
 	if ((CvCLONE(outside) && ! CvCLONED(outside))
@@ -1993,9 +1996,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
       }
     }
     depth = outside ? CvDEPTH(outside) : 0;
-#ifdef DEBUGGING
-    assert(depth || outside_arg || SvTYPE(proto) == SVt_PVFM);
-#endif
     if (!depth)
 	depth = 1;
     assert(SvTYPE(proto) == SVt_PVFM || CvPADLIST(outside));
@@ -2032,7 +2032,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
 		if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
 		 || (  SvPADSTALE(sv) && !SvPAD_STATE(namesv)
 		    && (!outside || !CvDEPTH(outside)))  ) {
-		    assert(SvTYPE(cv) == SVt_PVFM);
 		    Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
 				   "Variable \"%"SVf"\" is not available", namesv);
 		    sv = NULL;
diff --git a/t/cmd/lexsub.t b/t/cmd/lexsub.t
index 7fc3e5c0b6..293f70f226 100644
--- a/t/cmd/lexsub.t
+++ b/t/cmd/lexsub.t
@@ -519,21 +519,21 @@ sub not_lexical2 {
   };
   bar
 }
-$::TODO = 'closing over wrong sub';
 is not_lexical3, 23, 'my subs inside predeclared package subs';
 
 # Test my subs inside predeclared package sub, where the lexical sub is
 # declared outside the package sub.
 # This checks that CvOUTSIDE pointers are fixed up even when the sub is
 # not declared inside the sub that its CvOUTSIDE points to.
-{
+sub not_lexical5 {
   my sub foo;
   sub not_lexical4;
   sub not_lexical4 {
     my $x = 234;
+    not_lexical5();
     sub foo { $x }
-    foo
   }
-  is not_lexical4, 234,
-    'my sub defined in predeclared pkg sub but declared outside';
+  foo
 }
+is not_lexical4, 234,
+    'my sub defined in predeclared pkg sub but declared outside';