[perl #113812] Handle null CvOUTSIDE in cv_clone

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.

4 files changed, 18 insertions, 1 deletions

diff --git a/MANIFEST b/MANIFEST
index 203b4a60a0..38f5da2857 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 0ab4f5e441..56c9ed9211 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 7fdb829419..2cea6c8507 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 0000000000..c06250d975
--- /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' };
+	};