diff options
-rw-r--r-- | pad.c | 10 | ||||
-rwxr-xr-x | t/op/closure.t | 17 |
2 files changed, 21 insertions, 6 deletions
@@ -1494,17 +1494,17 @@ Perl_cv_clone(pTHX_ CV *proto) if (SvFAKE(namesv)) { /* lexical from outside? */ sv = outpad[PARENT_PAD_INDEX(namesv)]; assert(sv); - /* formats may have an inactive parent */ - if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) { + /* formats may have an inactive parent, + while my $x if $false can leave an active var marked as + stale */ + if (SvPADSTALE(sv)) { if (ckWARN(WARN_CLOSURE)) Perl_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%s\" is not available", SvPVX_const(namesv)); sv = NULL; } - /* 'my $x if $y' can leave $x stale even in an active sub */ - else if (!SvPADSTALE(sv)) { + else SvREFCNT_inc_simple_void_NN(sv); - } } if (!sv) { const char sigil = SvPVX_const(namesv)[0]; diff --git a/t/op/closure.t b/t/op/closure.t index 7d8df6a2cc..d1cab953a5 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,7 +688,22 @@ __EOF__ test { $flag == 1 }; } +# don't copy a stale lexical; crate a fresh undef one instead +sub f { + my $x if $_[0]; + sub { \$x } +} + +{ + f(1); + my $c1= f(0); + my $c2= f(0); + + my $r1 = $c1->(); + my $r2 = $c2->(); + test { $r1 != $r2 }; +} |