From: demerphq <demerphq@gmail.com>
Date: Thu, 15 Oct 2009 13:22:47 +0000 (+0100)
Subject: Support for pp_boolkeys in B::Deparse.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1c85afcecc8ee030e2780aa5bfa85692c8db64df;p=p5sagit%2Fp5-mst-13.2.git

Support for pp_boolkeys in B::Deparse.

Part of "[PATCH] Make if (%hash) {} act the same as if (keys %hash) {}"
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2006-11/msg00432.html
which evolved from the approach described in the subject, to instead add a new
opcode pp_boolkeys, to exactly preserve the existing behaviour.

Plus a $VERSION bump.
---

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index df7ed31..fbfee98 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -22,7 +22,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	 PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
 	 ($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE'),
 	 ($] < 5.011 ? 'CVf_LOCKED' : ());
-$VERSION = 0.91;
+$VERSION = 0.92;
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -1611,6 +1611,10 @@ sub unop {
     my($op, $cx, $name) = @_;
     my $kid;
     if ($op->flags & OPf_KIDS) {
+ 	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";
@@ -1655,6 +1659,10 @@ sub pp_chr { maybe_targmy(@_, \&unop, "chr") }
 sub pp_each { unop(@_, "each") }
 sub pp_values { unop(@_, "values") }
 sub pp_keys { unop(@_, "keys") }
+sub pp_boolkeys { 
+    # no name because its an optimisation op that has no keyword
+    unop(@_,"");
+}
 sub pp_aeach { unop(@_, "each") }
 sub pp_avalues { unop(@_, "values") }
 sub pp_akeys { unop(@_, "keys") }