Deparse: support delete %h{foo bar}

Key/value slicing was recently extended to delete too. Make Deparse
support this.

2 files changed, 20 insertions, 5 deletions

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 5f0afa2ee6..b22683ac49 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -12,7 +12,8 @@ use Carp;
 use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	 OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST
 	 OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPf_MOD OPf_PARENS
-	 OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE
+	 OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpKVSLICE
+         OPpCONST_BARE
 	 OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY
 	 OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpREPEAT_DOLIST
 	 OPpSORT_REVERSE OPpMULTIDEREF_EXISTS OPpMULTIDEREF_DELETE
@@ -362,7 +363,8 @@ BEGIN {
 
 
 BEGIN { for (qw[ const stringify rv2sv list glob pushmark null aelem
-		 nextstate dbstate rv2av rv2hv helem custom ]) {
+		 kvaslice kvhslice
+                 nextstate dbstate rv2av rv2hv helem custom ]) {
     eval "sub OP_\U$_ () { " . opnumber($_) . "}"
 }}
 
@@ -2677,7 +2679,7 @@ sub pp_delete {
     my($op, $cx) = @_;
     my $arg;
     my $name = $self->keyword("delete");
-    if ($op->private & OPpSLICE) {
+    if ($op->private & (OPpSLICE|OPpKVSLICE)) {
 	if ($op->flags & OPf_SPECIAL) {
 	    # Deleting from an array, not a hash
 	    return $self->maybe_parens_func($name,
@@ -4513,8 +4515,9 @@ sub slice {
     } else {
 	$list = $self->elem_or_slice_single_index($kid);
     }
-    my $lead = '@';
-    $lead = '%' if $op->name =~ /^kv/i;
+    my $lead = (   _op_is_or_was($op, OP_KVHSLICE)
+                || _op_is_or_was($op, OP_KVASLICE))
+               ? '%' : '@';
     return $lead . $array . $left . $list . $right;
 }
 
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index ab03ed7235..57c523c6cb 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -2649,3 +2649,15 @@ my Foo::Bar ($s4, @a4, %h4) :foo(f1, f2) bar(b1, b2);
 # avoid false positives in my $x :attribute
 'attributes'->import('main', \my $x1, 'foo(bar)'), my $y1;
 'attributes'->import('Fooo', \my $x2, 'foo(bar)'), my $y2;
+####
+# hash slices and hash key/value slices
+my(@a, %h);
+our(@oa, %oh);
+@a = @h{'foo', 'bar'};
+@a = %h{'foo', 'bar'};
+@a = delete @h{'foo', 'bar'};
+@a = delete %h{'foo', 'bar'};
+@oa = @oh{'foo', 'bar'};
+@oa = %oh{'foo', 'bar'};
+@oa = delete @oh{'foo', 'bar'};
+@oa = delete %oh{'foo', 'bar'};