From: David Leadbeater <dgl@dgl.cx>
Date: Thu, 25 Mar 2010 00:40:35 +0000 (+0000)
Subject: [perl #73720] opt_scalarhv(or OP_BOOLKEYS) does not work
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aaf643cef9412894b3ea120d62ac78b85d183930;p=p5sagit%2Fp5-mst-13.2.git

[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).
---

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");
 }