From 0f9db002b9f34078759729fa70bd1d6fb2350fb8 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 26 Jun 2012 09:23:06 -0700
Subject: [PATCH] [perl #113812] Handle null CvOUTSIDE in cv_clone
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Commit a0d2bbd stopped closures from hanging on to their
enclosing subs.

This means that the outer sub can be freed before the closure.  Since
it is only the outer sub that references the closure prototype (in a
'&' entry in its pad), when the outer sub is freed the closure proto-
type goes with it.  Now if that closure itself contains a closure
(more precisely, a closure prototype in its pad, referenced by an
anoncode op), that inner closure prototype’s CvOUTSIDE points to the
first closure prototype.  When that first closure prototype is freed
the innermost closure prototype has its CvOUTSIDE set to whatever the
outermost sub’s CvOUTSIDE was set to, which could be null if it is
in its own file.  So when the first closure is called, it passes to
cv_clone a closure prototype with no CvOUTSIDE.

cv_clone used to crash if CvOUTSIDE was null.

Example:
$ cat foo.pl

# the main CV of the file is the outer sub in this case
my $x
$first_closure = sub {
    $inner_closure = sub { $x }
}
$ perl -e 'require "./foo.pl"; $first_closure->()'
Bus error

This commit makes it use find_runcv when CvOUTSIDE is null.
---
 MANIFEST             |  1 +
 pad.c                |  2 +-
 t/op/closure.t       |  6 ++++++
 t/op/closure_test.pl | 10 ++++++++++
 4 files changed, 18 insertions(+), 1 deletion(-)
 create mode 100644 t/op/closure_test.pl

diff --git a/MANIFEST b/MANIFEST
index 203b4a6..38f5da2 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5191,6 +5191,7 @@ t/op/chdir.t			See if chdir works
 t/op/chop.t			See if chop works
 t/op/chr.t			See if chr works
 t/op/closure.t			See if closures work
+t/op/closure_test.pl		Extra file for closure.t
 t/op/cmp.t			See if the various string and numeric compare work
 t/op/concat2.t			Tests too complex for concat.t
 t/op/concat.t			See if string concatenation works
diff --git a/pad.c b/pad.c
index 0ab4f5e..56c9ed9 100644
--- a/pad.c
+++ b/pad.c
@@ -1880,7 +1880,7 @@ Perl_cv_clone(pTHX_ CV *proto)
      * Note that in general for formats, CvOUTSIDE != find_runcv */
 
     outside = CvOUTSIDE(proto);
-    if (outside && CvCLONE(outside) && ! CvCLONED(outside))
+    if (!outside || (CvCLONE(outside) && ! CvCLONED(outside)))
 	outside = find_runcv(NULL);
     depth = CvDEPTH(outside);
     assert(depth || SvTYPE(proto) == SVt_PVFM);
diff --git a/t/op/closure.t b/t/op/closure.t
index 7fdb829..2cea6c8 100644
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -727,5 +727,11 @@ BEGIN {
       'closures only close over named variables, not entire subs';
 }
 
+# [perl #113812] Closure prototypes with no CvOUTSIDE (crash caused by the
+#                fix for #89544)
+do "./op/closure_test.pl" or die $@||$!;
+is $closure_test::s2->()(), '10 cubes',
+  'cloning closure proto with no CvOUTSIDE';
+
 
 done_testing();
diff --git a/t/op/closure_test.pl b/t/op/closure_test.pl
new file mode 100644
index 0000000..c06250d
--- /dev/null
+++ b/t/op/closure_test.pl
@@ -0,0 +1,10 @@
+# This file exists to test closure prototypes with no CvOUTSIDE.  Only
+# by putting this in a separate file can we get a sub (this file’s
+# main CV) with no CvOUTSIDE.  When the outer sub is freed, the inner
+# subs also get CvOUTSIDE set to null.
+
+	my $x;
+	$closure_test::s2 = sub {
+	    $x;
+	    sub { $x; '10 cubes' };
+	};
-- 
1.8.3.1