In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/cae5dbbe30ba4a96ff5e570be0d90779f06fee71?hp=5ceaabe8e4e93dd375a9f43ffc52956b89ed492d>
- Log ----------------------------------------------------------------- commit cae5dbbe30ba4a96ff5e570be0d90779f06fee71 Author: Father Chrysostomos <[email protected]> Date: Sat Aug 4 14:42:47 2012 -0700 Close over stale vars in active subs \$x and sub { $x }->() should never produce different values. But this used to be possible because sub cloning (which happens with sub{...}) was written to avoid closing over variables that are not active. Not closing over inactive variables makes sense in cases like this (because the variable doesnât really exist yet): sub { my $x; sub foo { $x } } foo; but the logic breaks down in cases like this (which was printing 3 only on the first print): sub foo { my $x; sub bar { $x = 3; print $x, "\n"; sub { print $x, "\n" }->() } } bar(); If bar can see a scalar named $x (even if it is questionable), sub { $x }->() should jolly well see the same scalar as the immedi- ately enclosing sub. The only case where a run-time cloning of a CV should refuse to close over the same scalar that the outer sub sees is when the outer sub is not running. That only happens with formats: sub f { my $x; format = @ $x . } write STDOUT; As of this commit, it does only happen with formats. The actual cases of subs refusing to close over stale variables in active parents have changed twice since 5.10.0. See the comments in the tests. M pad.c M t/op/closure.t commit 3207fc6be298e308e8094e866ca339ba7e9a2790 Author: Father Chrysostomos <[email protected]> Date: Sat Aug 4 10:16:01 2012 -0700 sv.c:varname: Fix bad assertion added by c6fb3f6e #!perl -w my $x; format = @ "$x"; . write; __END__ Assertion failed: (!cv || SvTYPE(cv) == SVt_PVCV), function Perl_varname, file sv.c, line 13924. Abort trap M sv.c M t/lib/warnings/9uninit ----------------------------------------------------------------------- Summary of changes: pad.c | 3 ++- sv.c | 2 +- t/lib/warnings/9uninit | 12 ++++++++++++ t/op/closure.t | 43 +++++++++++++++++++++++++++++++++++-------- 4 files changed, 50 insertions(+), 10 deletions(-) diff --git a/pad.c b/pad.c index 71d5296..1e796e7 100644 --- a/pad.c +++ b/pad.c @@ -2020,7 +2020,8 @@ Perl_cv_clone(pTHX_ CV *proto) while my $x if $false can leave an active var marked as stale. And state vars are always available */ if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)]) - || (SvPADSTALE(sv) && !SvPAD_STATE(namesv))) { + || ( SvPADSTALE(sv) && !SvPAD_STATE(namesv) + && !CvDEPTH(outside)) ) { Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%"SVf"\" is not available", namesv); sv = NULL; diff --git a/sv.c b/sv.c index 4ad53cd..dd4f19a 100644 --- a/sv.c +++ b/sv.c @@ -13921,7 +13921,7 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ, SV *sv; AV *av; - assert(!cv || SvTYPE(cv) == SVt_PVCV); + assert(!cv || SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM); if (!cv || !CvPADLIST(cv)) return NULL; diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit index 4068fab..717e7f6 100644 --- a/t/lib/warnings/9uninit +++ b/t/lib/warnings/9uninit @@ -2034,3 +2034,15 @@ use warnings 'uninitialized'; "@{[ $x ]}"; EXPECT Use of uninitialized value in join or string at - line 3. +######## +# inside formats +use warnings 'uninitialized'; +my $x; +format = +@ +"$x"; +. +write; +EXPECT +Use of uninitialized value $x in string at - line 6. + diff --git a/t/op/closure.t b/t/op/closure.t index 3096fc6..73b43e4 100644 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -654,17 +654,19 @@ __EOF__ } sub f { - my $x if $_[0]; - sub { \$x } + my $x; + format ff = +@ +$r = \$x +. } { - f(1); - my $c1= f(0); - my $c2= f(0); - - my $r1 = $c1->(); - my $r2 = $c2->(); + fileno ff; + write ff; + my $r1 = $r; + write ff; + my $r2 = $r; isnt($r1, $r2, "don't copy a stale lexical; crate a fresh undef one instead"); } @@ -750,5 +752,30 @@ is $closure_test::s2->()(), '10 cubes', ::is $s2->()(), 3, 'cloning closure proto whose CvOUTSIDE has changed'; } +# This should never emit two different values: +# print $x, "\n"; +# print sub { $x }->(), "\n"; +# This test case started to do just that in commit 33894c1aa3e +# (5.10.1/5.12.0): +sub mosquito { + my $x if @_; + return if @_; + + $x = 17; + is sub { $x }->(), $x, 'closing over stale var in 2nd sub call'; +} +mosquito(1); +mosquito; +# And this case in commit adf8f095c588 (5.14): +sub anything { + my $x; + sub gnat { + $x = 3; + is sub { $x }->(), $x, + 'closing over stale var before 1st sub call'; + } +} +gnat(); + done_testing(); -- Perl5 Master Repository
