From: Dave Mitchell <davem@fdisolutions.com>
Date: Fri, 22 Jun 2007 23:46:36 +0000 (+0000)
Subject: safely handle cloning a stale lexical var
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=efa785391fea9e6aff4c999b27ad62b7d8f9ea99;p=p5sagit%2Fp5-mst-13.2.git

safely handle cloning a stale lexical var
This code:
    my $x if ...; sub { $x}
could attempt to clone $x even if $x is stale.

p4raw-id: //depot/perl@31447
---

diff --git a/pad.c b/pad.c
index 51592d0..07f994a 100644
--- a/pad.c
+++ b/pad.c
@@ -1501,8 +1501,8 @@ Perl_cv_clone(pTHX_ CV *proto)
 			    "Variable \"%s\" is not available", SvPVX_const(namesv));
 		    sv = NULL;
 		}
-		else {
-		    assert(!SvPADSTALE(sv));
+		/* 'my $x if $y' can leave $x stale even in an active sub */
+		else if (!SvPADSTALE(sv)) {
 		    SvREFCNT_inc_simple_void_NN(sv);
 		}
 	    }
diff --git a/t/op/closure.t b/t/op/closure.t
index 7d8df6a..ca774a2 100755
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -14,7 +14,7 @@ BEGIN {
 use Config;
 require './test.pl'; # for runperl()
 
-print "1..187\n";
+print "1..188\n";
 
 my $test = 1;
 sub test (&) {
@@ -688,6 +688,24 @@ __EOF__
     test { $flag == 1 };
 }
 
+# although the 'my $x if ...' form is deprecated, it must still work.
+# Ensure that cloning a stale var gives a new undef value rather than
+# sharing the old value
+
+{ 
+    sub f {
+	my $a = 1 if $_[0];
+	return sub { \$a };
+    }
+    my $c1 = f(1);
+    my $c2 = f(0);
+    my $r1 = $c1->();
+    my $r2 = $c2->();
+    warn "r1=$r1 r2=$r2\n";
+    test { !defined $$r2 };
+    test { $r1 ne $r2 };
+}
+