In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/aaf643cef9412894b3ea120d62ac78b85d183930?hp=7cf8de9f707ac211c67434c5349598951c28a81c>
- Log -----------------------------------------------------------------
commit aaf643cef9412894b3ea120d62ac78b85d183930
Author: David Leadbeater <d...@dgl.cx>
Date: Thu Mar 25 00:40:35 2010 +0000
[perl #73720] opt_scalarhv(or OP_BOOLKEYS) does not work
An optimisation for %hash in boolean context, as introduced with
867fa1e2da145229b4db2c6e8d5b51700c15f114
could falsely optimise constructs that shoudn't be.
Original bug report and fix suggestion were by Goro Fuji.
Include a test to cover the case which was mis-optimised (although
coverage still seems low to me).
Additionally correct B::Deparse (just swap a line, it was using a
variable before it was defined).
-----------------------------------------------------------------------
Summary of changes:
dist/B-Deparse/Deparse.pm | 2 +-
op.c | 4 ++--
t/op/each.t | 6 +++++-
3 files changed, 8 insertions(+), 4 deletions(-)
diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 6cdcd05..31d28fb 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -1593,11 +1593,11 @@ sub unop {
my($op, $cx, $name) = @_;
my $kid;
if ($op->flags & OPf_KIDS) {
+ $kid = $op->first;
if (not $name) {
# this deals with 'boolkeys' right now
return $self->deparse($kid,$cx);
}
- $kid = $op->first;
my $builtinname = $name;
$builtinname =~ /^CORE::/ or $builtinname = "CORE::$name";
if (defined prototype($builtinname)
diff --git a/op.c b/op.c
index c4289ce..7754923 100644
--- a/op.c
+++ b/op.c
@@ -8680,7 +8680,7 @@ Perl_peep(pTHX_ register OP *o)
){
OP * nop = o;
OP * lop = o;
- if (!(nop->op_flags && OPf_WANT_VOID)) {
+ if (!((nop->op_flags & OPf_WANT) == OPf_WANT_VOID)) {
while (nop && nop->op_next) {
switch (nop->op_next->op_type) {
case OP_NOT:
@@ -8698,7 +8698,7 @@ Perl_peep(pTHX_ register OP *o)
}
}
}
- if (lop->op_flags && OPf_WANT_VOID) {
+ if ((lop->op_flags & OPf_WANT) == OPf_WANT_VOID) {
if (fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV)
cLOGOP->op_first = opt_scalarhv(fop);
if (sop && (sop->op_type == OP_PADHV || sop->op_type ==
OP_RV2HV))
diff --git a/t/op/each.t b/t/op/each.t
index 765bfda..a7b128a 100644
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -6,7 +6,7 @@ BEGIN {
require './test.pl';
}
-plan tests => 52;
+plan tests => 54;
$h{'abc'} = 'ABC';
$h{'def'} = 'DEF';
@@ -216,6 +216,8 @@ for my $k (qw(each keys values)) {
is($rest,3,"Got the expect number of keys");
my $hsv=1 && %foo;
like($hsv,'/',"Got bucket stats from %foo in scalar assignment context");
+ my @arr=%foo&&%foo;
+ is(@arr,10,"Got expected number of elements in list context");
}
{
our %foo=(1..10);
@@ -233,4 +235,6 @@ for my $k (qw(each keys values)) {
is($rest,3,"Got the expect number of keys");
my $hsv=1 && %foo;
like($hsv,'/',"Got bucket stats from %foo in scalar assignment context");
+ my @arr=%foo&&%foo;
+ is(@arr,10,"Got expected number of elements in list context");
}
--
Perl5 Master Repository
