[perl #89544] Non-eval closures don’t need CvOUTSIDE

A closure doesn’t need an outside pointer at run time, unless it has a
string eval in it.  CvOUTSIDE is only used at compilation time to look
up variables by name.

Since CvOUTSIDE is reference-counted, a closure can unnecessarily hang
on to variables it is not using (see the test in the diff).  So stop
setting it when cloning a closure, unless it is needed for eval.

3 files changed, 34 insertions, 1 deletions

diff --git a/cv.h b/cv.h
index 96308a2938..072ff1e086 100644
--- a/cv.h
+++ b/cv.h
@@ -107,6 +107,7 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CVf_CVGV_RC	0x0400	/* CvGV is reference counted */
 #define CVf_DYNFILE	0x1000	/* The filename isn't static  */
 #define CVf_AUTOLOAD	0x2000	/* SvPVX contains AUTOLOADed sub name  */
+#define CVf_HASEVAL	0x4000	/* contains string eval  */
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS	(CVf_METHOD|CVf_LVALUE)
@@ -174,6 +175,10 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CvAUTOLOAD_on(cv)	(CvFLAGS(cv) |= CVf_AUTOLOAD)
 #define CvAUTOLOAD_off(cv)	(CvFLAGS(cv) &= ~CVf_AUTOLOAD)
 
+#define CvHASEVAL(cv)		(CvFLAGS(cv) & CVf_HASEVAL)
+#define CvHASEVAL_on(cv)	(CvFLAGS(cv) |= CVf_HASEVAL)
+#define CvHASEVAL_off(cv)	(CvFLAGS(cv) &= ~CVf_HASEVAL)
+
 /* Flags for newXS_flags  */
 #define XS_DYNAMIC_FILENAME	0x01	/* The filename isn't static  */
 
diff --git a/pad.c b/pad.c
index 468ba6c3a1..0ab4f5e441 100644
--- a/pad.c
+++ b/pad.c
@@ -1624,6 +1624,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 		DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 		    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
 		CvCLONE_on(cv);
+		CvHASEVAL_on(cv);
 	    }
 	}
     }
@@ -1902,7 +1903,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
     OP_REFCNT_UNLOCK;
     CvSTART(cv)		= CvSTART(proto);
-    CvOUTSIDE(cv)	= MUTABLE_CV(SvREFCNT_inc_simple(outside));
+    if (CvHASEVAL(cv))
+	CvOUTSIDE(cv)	= MUTABLE_CV(SvREFCNT_inc_simple(outside));
     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
 
     if (SvPOK(proto))
diff --git a/t/op/closure.t b/t/op/closure.t
index a241d91477..7fdb829419 100644
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -699,7 +699,33 @@ BEGIN {
     isnt($s[0], $s[1], "cloneable with //ee");
 }
 
+# [perl #89544]
+{
+   sub trace::DESTROY {
+       push @trace::trace, "destroyed";
+   }
+
+   my $outer2 = sub {
+       my $a = bless \my $dummy, trace::;
+
+       my $outer = sub {
+	   my $b;
+	   my $inner = sub {
+	       undef $b;
+	   };
+
+	   $a;
 
+	   $inner
+       };
+
+       $outer->()
+   };
+
+   my $inner = $outer2->();
+   is "@trace::trace", "destroyed",
+      'closures only close over named variables, not entire subs';
+}
 
 
 done_testing();