[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.

diff --git a/cv.h b/cv.h
index 96308a2..072ff1e 100644 (file)
--- 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 468ba6c..0ab4f5e 100644 (file)
--- 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 a241d91..7fdb829 100644 (file)
--- 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();