[perl #113812] Always use find_runcv when cloning a sub
authorFather Chrysostomos <sprout@cpan.org>
Fri, 29 Jun 2012 06:12:23 +0000 (23:12 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 29 Jun 2012 07:51:10 +0000 (00:51 -0700)
A closure prototype’s CvOUTSIDE pointer might have been modified if
its containing sub is freed first.  When a sub is cloned, the enclos-
ing sub is always the currently-running sub (not so for formats).

So this commit makes subs always use find_runcv, the way they did
before 71f882da828.

So the closure logic which was needed for formats is now moved into an
else branch that is used only for them.

pad.c
t/op/closure.t

diff --git a/pad.c b/pad.c
index 9f6ccb8..8609156 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1929,12 +1929,16 @@ Perl_cv_clone(pTHX_ CV *proto)
      * inside closures, however, only work if CvOUTSIDE == find_runcv.
      */
 
-    outside = CvOUTSIDE(proto);
-    if (!outside || (CvCLONE(outside) && ! CvCLONED(outside)))
+    if (SvTYPE(proto) == SVt_PVCV)
        outside = find_runcv(NULL);
-    if (SvTYPE(proto) == SVt_PVFM
-     && CvROOT(outside) != CvROOT(CvOUTSIDE(proto)))
+    else {
        outside = CvOUTSIDE(proto);
+       if (CvCLONE(outside) && ! CvCLONED(outside)) {
+           CV * const runcv = find_runcv(NULL);
+           if (CvROOT(runcv) == CvROOT(outside))
+               outside = runcv;
+       }
+    }
     depth = CvDEPTH(outside);
     assert(depth || SvTYPE(proto) == SVt_PVFM);
     if (!depth)
index 2cea6c8..3096fc6 100644 (file)
@@ -733,5 +733,22 @@ do "./op/closure_test.pl" or die $@||$!;
 is $closure_test::s2->()(), '10 cubes',
   'cloning closure proto with no CvOUTSIDE';
 
+# Also brought up in #113812: Even when being cloned, a closure prototype
+# might have its CvOUTSIDE pointing to the wrong thing.
+{
+    package main::113812;
+    $s1 = sub {
+       my $x = 3;
+       $s2 = sub {
+           $x;
+           $s3 = sub { $x };
+       };
+    };
+    $s1->();
+    undef &$s1; # frees $s2’s prototype, causing the $s3 proto to have its
+                # CvOUTSIDE point to $s1
+    ::is $s2->()(), 3, 'cloning closure proto whose CvOUTSIDE has changed';
+}
+
 
 done_testing();