+# a simplified version of elem_or_slice_array_name()
+# for the use of pp_multideref
+
+sub multideref_var_name {
+ my $self = shift;
+ my ($gv, $is_hash) = @_;
+
+ my ($name, $quoted) =
+ $self->stash_variable_name( $is_hash ? '%' : '@', $gv);
+ return $quoted ? "$name->"
+ : $name eq '#'
+ ? '${#}' # avoid ${#}[1] => $#[1]
+ : '$' . $name;
+}
+
+
+# deparse an OP_MULTICONCAT. If $in_dq is 1, we're within
+# a double-quoted string, so for example.
+# "abc\Qdef$x\Ebar"
+# might get compiled as
+# multiconcat("abc", metaquote(multiconcat("def", $x)), "bar")
+# and the inner multiconcat should be deparsed as C<def$x> rather than
+# the normal C<def . $x>
+# Ditto if $in_dq is 2, handle qr/...\Qdef$x\E.../.
+
+sub do_multiconcat {
+ my $self = shift;
+ my($op, $cx, $in_dq) = @_;
+
+ my $kid;
+ my @kids;
+ my $assign;
+ my $append;
+ my $lhs = "";
+
+ for ($kid = $op->first; !null $kid; $kid = $kid->sibling) {
+ # skip the consts and/or padsv we've optimised away
+ push @kids, $kid
+ unless $kid->type == OP_NULL
+ && ( $kid->targ == OP_PADSV
+ || $kid->targ == OP_CONST
+ || $kid->targ == OP_PUSHMARK);
+ }
+
+ $append = ($op->private & OPpMULTICONCAT_APPEND);
+
+ if ($op->private & OPpTARGET_MY) {
+ # '$lex = ...' or '$lex .= ....' or 'my $lex = '
+ $lhs = $self->padname($op->targ);
+ $lhs = "my $lhs" if ($op->private & OPpLVAL_INTRO);
+ $assign = 1;
+ }
+ elsif ($op->flags & OPf_STACKED) {
+ # 'expr = ...' or 'expr .= ....'
+ my $expr = $append ? shift(@kids) : pop(@kids);
+ $lhs = $self->deparse($expr, 7);
+ $assign = 1;
+ }
+
+ if ($assign) {
+ $lhs .= $append ? ' .= ' : ' = ';
+ }
+
+ my ($nargs, $const_str, @const_lens) = $op->aux_list($self->{curcv});
+
+ my @consts;
+ my $i = 0;
+ for (@const_lens) {
+ if ($_ == -1) {
+ push @consts, undef;
+ }
+ else {
+ push @consts, substr($const_str, $i, $_);
+ my @args;
+ $i += $_;
+ }
+ }
+
+ my $rhs = "";
+
+ if ( $in_dq
+ || (($op->private & OPpMULTICONCAT_STRINGIFY) && !$self->{'unquote'}))
+ {
+ # "foo=$foo bar=$bar "
+ my $not_first;
+ while (@consts) {
+ $rhs = dq_disambiguate($rhs, $self->dq(shift(@kids), 18))
+ if $not_first;
+ $not_first = 1;
+ my $c = shift @consts;
+ if (defined $c) {
+ if ($in_dq == 2) {
+ # in pattern: don't convert newline to '\n' etc etc
+ my $s = re_uninterp(escape_re(re_unback($c)));
+ $rhs = re_dq_disambiguate($rhs, $s)
+ }
+ else {
+ my $s = uninterp(escape_str(unback($c)));
+ $rhs = dq_disambiguate($rhs, $s)
+ }
+ }
+ }
+ return $rhs if $in_dq;
+ $rhs = single_delim("qq", '"', $rhs, $self);
+ }
+ elsif ($op->private & OPpMULTICONCAT_FAKE) {
+ # sprintf("foo=%s bar=%s ", $foo, $bar)
+
+ my @all;
+ @consts = map { $_ //= ''; s/%/%%/g; $_ } @consts;
+ my $fmt = join '%s', @consts;
+ push @all, $self->quoted_const_str($fmt);
+
+ # the following is a stripped down copy of sub listop {}
+ my $parens = $assign || ($cx >= 5) || $self->{'parens'};
+ my $fullname = $self->keyword('sprintf');
+ push @all, map $self->deparse($_, 6), @kids;
+
+ $rhs = $parens
+ ? "$fullname(" . join(", ", @all) . ")"
+ : "$fullname " . join(", ", @all);
+ }
+ else {
+ # "foo=" . $foo . " bar=" . $bar
+ my @all;
+ my $not_first;
+ while (@consts) {
+ push @all, $self->deparse(shift(@kids), 18) if $not_first;
+ $not_first = 1;
+ my $c = shift @consts;
+ if (defined $c) {
+ push @all, $self->quoted_const_str($c);
+ }
+ }
+ $rhs .= join ' . ', @all;
+ }
+
+ my $text = $lhs . $rhs;
+
+ $text = "($text)" if ($cx >= (($assign) ? 7 : 18+1))
+ || $self->{'parens'};
+
+ return $text;
+}
+
+
+sub pp_multiconcat {
+ my $self = shift;
+ $self->do_multiconcat(@_, 0);
+}
+
+
+sub pp_multideref {
+ my $self = shift;
+ my($op, $cx) = @_;
+ my $text = "";
+
+ if ($op->private & OPpMULTIDEREF_EXISTS) {
+ $text = $self->keyword("exists"). " ";
+ }
+ elsif ($op->private & OPpMULTIDEREF_DELETE) {
+ $text = $self->keyword("delete"). " ";
+ }
+ elsif ($op->private & OPpLVAL_INTRO) {
+ $text = $self->keyword("local"). " ";
+ }
+
+ if ($op->first && ($op->first->flags & OPf_KIDS)) {
+ # arbitrary initial expression, e.g. f(1,2,3)->[...]
+ my $expr = $self->deparse($op->first, 24);
+ # stop "exists (expr)->{...}" being interpreted as
+ #"(exists (expr))->{...}"
+ $expr = "+$expr" if $expr =~ /^\(/;
+ $text .= $expr;
+ }
+
+ my @items = $op->aux_list($self->{curcv});
+ my $actions = shift @items;
+
+ my $is_hash;
+ my $derefs = 0;
+
+ while (1) {
+ if (($actions & MDEREF_ACTION_MASK) == MDEREF_reload) {
+ $actions = shift @items;
+ next;
+ }
+
+ $is_hash = (
+ ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_pop_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_gvsv_vivify_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_padsv_vivify_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_vivify_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_padhv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_gvhv_helem
+ );
+
+ if ( ($actions & MDEREF_ACTION_MASK) == MDEREF_AV_padav_aelem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_padhv_helem)
+ {
+ $derefs = 1;
+ $text .= '$' . substr($self->padname(shift @items), 1);
+ }
+ elsif ( ($actions & MDEREF_ACTION_MASK) == MDEREF_AV_gvav_aelem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_gvhv_helem)
+ {
+ $derefs = 1;
+ $text .= $self->multideref_var_name(shift @items, $is_hash);
+ }
+ else {
+ if ( ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_AV_padsv_vivify_rv2av_aelem
+ || ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_HV_padsv_vivify_rv2hv_helem)
+ {
+ $text .= $self->padname(shift @items);
+ }
+ elsif ( ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_AV_gvsv_vivify_rv2av_aelem
+ || ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_HV_gvsv_vivify_rv2hv_helem)
+ {
+ $text .= $self->multideref_var_name(shift @items, $is_hash);
+ }
+ elsif ( ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_AV_pop_rv2av_aelem
+ || ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_HV_pop_rv2hv_helem)
+ {
+ if ( ($op->flags & OPf_KIDS)
+ && ( _op_is_or_was($op->first, OP_RV2AV)
+ || _op_is_or_was($op->first, OP_RV2HV))
+ && ($op->first->flags & OPf_KIDS)
+ && ( _op_is_or_was($op->first->first, OP_AELEM)
+ || _op_is_or_was($op->first->first, OP_HELEM))
+ )
+ {
+ $derefs++;
+ }
+ }
+
+ $text .= '->' if !$derefs++;
+ }
+
+
+ if (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_none) {
+ last;
+ }
+
+ $text .= $is_hash ? '{' : '[';
+
+ if (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_const) {
+ my $key = shift @items;
+ if ($is_hash) {
+ $text .= $self->const($key, $cx);
+ }
+ else {
+ $text .= $key;
+ }
+ }
+ elsif (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_padsv) {
+ $text .= $self->padname(shift @items);
+ }
+ elsif (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_gvsv) {
+ $text .= '$' . ($self->stash_variable_name('$', shift @items))[0];
+ }
+
+ $text .= $is_hash ? '}' : ']';
+
+ if ($actions & MDEREF_FLAG_last) {
+ last;
+ }
+ $actions >>= MDEREF_SHIFT;
+ }
+
+ return $text;
+}
+
+