From 04472a849792297300059ba880a7ad59900aa5b8 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 4 Nov 2014 13:25:49 -0800
Subject: [PATCH] pad.c:cv_clone_pad: Avoid copying sv
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

When we capture the lexical variable in order to make sub () {$x}
constant, we don’t have to copy it if it is not modified or referenced
elsewhere.
---
 pad.c   | 20 ++++++++++++++++----
 scope.c |  1 -
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/pad.c b/pad.c
index 9625de9..0775a42 100644
--- a/pad.c
+++ b/pad.c
@@ -2190,6 +2190,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 	 * from the parent */
 	if (const_sv && SvREFCNT(const_sv) == 2) {
 	    const bool was_method = cBOOL(CvMETHOD(cv));
+	    bool copied = FALSE;
 	    if (outside) {
 		PADNAME * const pn =
 		    PadlistNAMESARRAY(CvPADLIST(outside))
@@ -2217,20 +2218,31 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 			 cUNOPx(cUNOPx(CvROOT(cv))->op_first)->op_first
 			) == o
 		     && !OP_SIBLING(o))
+		    {
 			Perl_ck_warner_d(aTHX_
 					  packWARN(WARN_DEPRECATED),
 					 "Constants from lexical "
 					 "variables potentially "
 					 "modified elsewhere are "
 					 "deprecated");
+			/* We *copy* the lexical variable, and donate the
+			   copy to newCONSTSUB.  Yes, this is ugly, and
+			   should be killed.  We need to do this for the
+			   time being, however, because turning on SvPADTMP
+			   on a lexical will have observable effects
+			   elsewhere.  */
+			const_sv = newSVsv(const_sv);
+			copied = TRUE;
+		    }
 		    else
 			goto constoff;
 		}
 	    }
-	    /* We *copy* the lexical variable, and donate the copy to
-	       newCONSTSUB.  Yes, this is ugly, and should be killed.
-	       XXX Is it possible to eliminate this now?  */
-	    const_sv = newSVsv(const_sv);
+	    if (!copied)
+		SvREFCNT_inc_simple_void_NN(const_sv);
+	    /* If the lexical is not used elsewhere, it is safe to turn on
+	       SvPADTMP, since it is only when it is used in lvalue con-
+	       text that the difference is observable.  */
 	    SvPADTMP_on(const_sv);
 	    SvREFCNT_dec_NN(cv);
 	    cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
diff --git a/scope.c b/scope.c
index 0f819e7..43e2e03 100644
--- a/scope.c
+++ b/scope.c
@@ -1079,7 +1079,6 @@ Perl_leave_scope(pTHX_ I32 base)
                     SvPADSTALE_on(sv); /* mark as no longer live */
                 }
                 else {	/* Someone has a claim on this, so abandon it. */
-                    assert(!(SvFLAGS(sv) & SVs_PADTMP));
                     switch (SvTYPE(sv)) {	/* Console ourselves with a new value */
                     case SVt_PVAV:	*svp = MUTABLE_SV(newAV());	break;
                     case SVt_PVHV:	*svp = MUTABLE_SV(newHV());	break;
-- 
1.8.3.1