[perl #73720] opt_scalarhv(or OP_BOOLKEYS) does not work
David Leadbeater [Thu, 25 Mar 2010 00:40:35 +0000 (00:40 +0000)]
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).

dist/B-Deparse/Deparse.pm
op.c
t/op/each.t

index 6cdcd05..31d28fb 100644 (file)
@@ -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 (file)
--- 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)) 
index 765bfda..a7b128a 100644 (file)
@@ -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");
 }