Deparse.pm: handle postfix $r->$#*

(\my @a)->$#*

was being deparsed as

$#{\my @a}

which incorrectly reduced the scope of the lexical @a.

Make Deparse.pm recognise this case and use the new postfix notation
instead.

This fixes

    ./TEST -deparse op/array.t

which was using ->$#*.

2 files changed, 40 insertions, 4 deletions

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 7fca6886d7..23045a8dd3 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -4194,11 +4194,28 @@ sub pp_rv2hv {
 sub pp_av2arylen {
     my $self = shift;
     my($op, $cx) = @_;
-    if ($op->first->name eq "padav") {
-	return $self->maybe_local($op, $cx, '$#' . $self->padany($op->first));
+    my $kid = $op->first;
+    if ($kid->name eq "padav") {
+	return $self->maybe_local($op, $cx, '$#' . $self->padany($kid));
     } else {
-	return $self->maybe_local($op, $cx,
-				  $self->rv2x($op->first, $cx, '$#'));
+        my $kkid;
+        if (   $kid->name eq "rv2av"
+           && ($kkid = $kid->first)
+           && $kkid->name !~ /^(scope|leave|gv)$/)
+        {
+            # handle (expr)->$#* postfix form
+            my $expr;
+            $expr = $self->deparse($kkid, 24); # 24 is '->'
+            $expr = "$expr->\$#*";
+            # XXX maybe_local is probably wrong here: local($#-expression)
+            # doesn't "do" local (the is no INTRO flag set)
+            return $self->maybe_local($op, $cx, $expr);
+        }
+        else {
+            # handle $#{expr} form
+            # XXX see maybe_local comment above
+            return $self->maybe_local($op, $cx, $self->rv2x($kid, $cx, '$#'));
+        }
     }
 }
 
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 9c25007ea3..2451ce5e77 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -3044,3 +3044,22 @@ state %i :shared = ('a', 1, 'b', 2);
 my $r = \our @a;
 my(@l) = \our((@b));
 @l = \our(@c, @d);
+####
+# postfix $#
+our(@b, $s, $l);
+$l = (\my @a)->$#*;
+(\@b)->$#* = 1;
+++(\my @c)->$#*;
+$l = $#a;
+$#a = 1;
+$l = $#b;
+$#b = 1;
+my $r;
+$l = $r->$#*;
+$r->$#* = 1;
+$l = $#{@$r;};
+$#{$r;} = 1;
+$l = $s->$#*;
+$s->$#* = 1;
+$l = $#{@$s;};
+$#{$s;} = 1;