From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Wed, 6 Jun 2001 11:45:08 +0000 (+0000)
Subject: Integrate changes #10450 and #10451 from maintperl:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c975facca21cbb3c09f2683defbaf68948a91e9a;p=p5sagit%2Fp5-mst-13.2.git

Integrate changes #10450 and #10451 from maintperl:

optimize change#10448 slightly (don't repeat search in eval""s lexical
scope, since that has already been searched)

change#9108 needs subtler treatment for case of closures created
within eval""

p4raw-link: @10450 on //depot/maint-5.6/perl: 77991f234c231cb11047bb180fdeef1134557583
p4raw-link: @10448 on //depot/maint-5.6/perl: 332ba4f98bc63c81fd7ba0d06432a7f903d716cf
p4raw-link: @9108 on //depot/maint-5.6/perl: 1cf1f64f42eb50a67f2427ff9d6d24023a2b9997

p4raw-id: //depot/perl@10454
p4raw-integrated: from //depot/maint-5.6/perl@10453 'merge in'
	t/op/misc.t (@10448..) op.c (@10450..)
---

diff --git a/op.c b/op.c
index 1874518..08e2ed4 100644
--- a/op.c
+++ b/op.c
@@ -357,10 +357,12 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 		    saweval = i;
 		    seq = cxstack[i].blk_oldcop->cop_seq;
 		    startcv = cxstack[i].blk_eval.cv;
-		    off = pad_findlex(name, newoff, seq, startcv, i-1,
-				      saweval, 0);
-		    if (off)	/* continue looking if not found here */
-			return off;
+		    if (startcv && CvOUTSIDE(startcv)) {
+			off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv),
+					  i-1, saweval, 0);
+			if (off)	/* continue looking if not found here */
+			    return off;
+		    }
 		}
 		break;
 	    case OP_DOFILE:
@@ -4174,9 +4176,14 @@ Perl_cv_undef(pTHX_ CV *cv)
      * CV, they don't hold a refcount on the outside CV.  This avoids
      * the refcount loop between the outer CV (which keeps a refcount to
      * the closure prototype in the pad entry for pp_anoncode()) and the
-     * closure prototype, and the ensuing memory leak.  --GSAR */
-    if (!CvANON(cv) || CvCLONED(cv))
+     * closure prototype, and the ensuing memory leak.  This does not
+     * apply to closures generated within eval"", since eval"" CVs are
+     * ephemeral. --GSAR */
+    if (!CvANON(cv) || CvCLONED(cv)
+	|| (CvOUTSIDE(cv) && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+    {
 	SvREFCNT_dec(CvOUTSIDE(cv));
+    }
     CvOUTSIDE(cv) = Nullcv;
     if (CvCONST(cv)) {
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
@@ -4815,12 +4822,16 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
     }
 
-    /* If a potential closure prototype, don't keep a refcount on outer CV.
+    /* If a potential closure prototype, don't keep a refcount on
+     * outer CV, unless the latter happens to be a passing eval"".
      * This is okay as the lifetime of the prototype is tied to the
      * lifetime of the outer CV.  Avoids memory leak due to reference
      * loop. --GSAR */
-    if (!name)
+    if (!name && CvOUTSIDE(cv)
+	&& !(CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv))))
+    {
 	SvREFCNT_dec(CvOUTSIDE(cv));
+    }
 
     if (name || aname) {
 	char *s;
diff --git a/t/op/misc.t b/t/op/misc.t
index 881f99d..679dd91 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -599,6 +599,16 @@ EOT
 EXPECT
 ok
 ########
+# test that closures generated by eval"" hold on to the CV of the eval""
+# for their entire lifetime
+$code = eval q[
+  sub { eval '$x = "ok 1\n"'; }
+];
+&{$code}();
+print $x;
+EXPECT
+ok 1
+########
 # This test is here instead of pragma/locale.t because
 # the bug depends on in the internal state of the locale
 # settings and pragma/locale messes up that state pretty badly.