From 8d88fe29d7f8e580970ac5a994ba499606884c4c Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 14 Aug 2012 18:10:40 -0700
Subject: [PATCH] Use the right outside for my subs defined in inner subs
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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.
---
 pad.c          | 13 ++++++-------
 t/cmd/lexsub.t | 10 +++++-----
 2 files changed, 11 insertions(+), 12 deletions(-)

diff --git a/pad.c b/pad.c
index 941f663..29ad4ad 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 7fc3e5c..293f70f 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';
-- 
2.7.4