In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3ad6135dbb7d518600eac9177c7f007cdfccf5ba?hp=f80c2205cb723cd2cf47ce4d256d279c74a46325>
- Log ----------------------------------------------------------------- commit 3ad6135dbb7d518600eac9177c7f007cdfccf5ba Author: Father Chrysostomos <[email protected]> Date: Mon Nov 29 06:09:37 2010 -0800 perldelta entry for [perl #63540] M pod/perldelta.pod commit dbe92b04c262cab7908c1678a21a3dac03a61e15 Author: Father Chrysostomos <[email protected]> Date: Mon Nov 29 06:05:35 2010 -0800 [perl #63540] bizarre closure lossage main::b in this example shows a null op that has the if() statement attached to it. $ perl -MO=Concise,a,b -e 'my $x;sub a {$x}; sub b{if($x){}0}' main::a: 3 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->3 1 <;> nextstate(main 2 -e:1) v ->2 2 <0> padsv[$x:FAKE:] ->3 main::b: a <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->a 4 <;> nextstate(main 5 -e:1) v ->5 - <1> null vK/1 ->8 6 <|> and(other->7) vK/1 ->8 5 <0> padsv[$x:FAKE:] s ->6 - <@> scope vK ->- 7 <0> stub v ->8 8 <;> nextstate(main 5 -e:1) v ->9 9 <$> const[IV 0] s ->a -e syntax OK Perl_op_const_sv has: if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) continue; It traverses from the null to the const. The constâs op_next pointer points to the leavesub, so it is taken to be a constant. It returns to newATTRSUB, which turns on CvCONST without assigning a constant value. Later, cv_clone (called by pp_anoncode) calls op_const_sv again. The latter returns the SV from the first PADSV it finds, which is the $x in if($x). This commit stops op_const_sv from skipping over null ops that have children. M op.c M t/op/closure.t ----------------------------------------------------------------------- Summary of changes: op.c | 4 +++- pod/perldelta.pod | 18 ++++++++++++++---- t/op/closure.t | 14 +++++++++++++- 3 files changed, 30 insertions(+), 6 deletions(-) diff --git a/op.c b/op.c index 4c3c876..20083ad 100644 --- a/op.c +++ b/op.c @@ -6023,7 +6023,9 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv) if (sv && o->op_next == o) return sv; if (o->op_next != o) { - if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) + if (type == OP_NEXTSTATE + || (type == OP_NULL && !(o->op_flags & OPf_KIDS)) + || type == OP_PUSHMARK) continue; if (type == OP_DBSTATE) continue; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 934b1d8..2f80f34 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -1,7 +1,7 @@ =encoding utf8 =for comment -This has been completed up to baed7a7, except for 1b9f127-fad448f, which +This has been completed up to dbe92b04c, except for 1b9f127-fad448f, which Karl Williamson says he will do. =head1 NAME @@ -440,6 +440,18 @@ A reference to a literal value used as a hash key (C<$hash{\"foo"}>) used to be stringified, even if the hash was tied L<[perl #79178]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=79178>. +=item * + +A number of bugs with regular expression bracketed character classes +have been fixed, mostly having to do with matching characters in the +non-ASCII Latin-1 range. + +=item * + +A closure containing an C<if> statement followed by a constant or variable +is no longer treated as a constant +L<[perl #63540]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=63540>. + =back =head1 Known Problems @@ -457,9 +469,7 @@ from either 5.XXX.XXX or 5.XXX.XXX. =item * -A number of bugs with regular expression bracketed character classes -have been fixed, mostly having to do with matching characters in the -non-ASCII Latin-1 range. +XXX =back diff --git a/t/op/closure.t b/t/op/closure.t index 5e3bf45..1248cf5 100644 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -14,7 +14,7 @@ BEGIN { use Config; require './test.pl'; # for runperl() -print "1..188\n"; +print "1..190\n"; my $test = 1; sub test (&) { @@ -701,6 +701,18 @@ sub f { test { $r1 != $r2 }; } +# [perl #63540] Donât treat sub { if(){.....}; "constant" } as a constant +BEGIN { + my $x = 7; + *baz = sub() { if($x){ () = "tralala"; blonk() }; 0 } +} +{ + my $blonk_was_called; + *blonk = sub { ++$blonk_was_called }; + my $ret = baz(); + test { $ret == 0 or diag("got $ret at line ".__LINE__),0 }; + test { $blonk_was_called }; +} -- Perl5 Master Repository
