B::Deparse misdeparses qq(@,)

This commit changes the signature of stash_variable() in B::Deparse.
stash_variable() takes $cx value additionally to know whether or not
it is in the interpolation context.

Punctuation arrays such as @* are usually interpolated only if the
name is enclosed in braces @{*}, but the arrays @_, @+, @- are
interpolated even without braces.

related issue: #93990

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index a53000a..848b2fa 100644 (file)
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -1276,7 +1276,7 @@ Carp::confess() unless ref($gv) eq "B::GV";
 # If a lexical with the same name is in scope, it may need to be
 # fully-qualified.
 sub stash_variable {
-    my ($self, $prefix, $name) = @_;
+    my ($self, $prefix, $name, $cx) = @_;
 
     return "$prefix$name" if $name =~ /::/;
 
@@ -1285,6 +1285,12 @@ sub stash_variable {
        return "$prefix$name";
     }
 
+    if (defined $cx && $cx == 26) {
+       if ($prefix eq '@' && $name =~ /^[^\w+-]$/) {
+           return "$prefix\{$name}";
+       }
+    }
+
     my $v = ($prefix eq '$#' ? '@' : $prefix) . $name;
     return $prefix .$self->{'curstash'}.'::'. $name if $self->lex_in_scope($v);
     return "$prefix$name";
@@ -2922,7 +2928,7 @@ sub pp_gvsv {
     my($op, $cx) = @_;
     my $gv = $self->gv_or_padgv($op);
     return $self->maybe_local($op, $cx, $self->stash_variable("\$",
-                                $self->gv_name($gv)));
+                                $self->gv_name($gv), $cx));
 }
 
 sub pp_gv {
@@ -2964,7 +2970,7 @@ sub rv2x {
     }
     my $kid = $op->first;
     if ($kid->name eq "gv") {
-       return $self->stash_variable($type, $self->deparse($kid, 0));
+       return $self->stash_variable($type, $self->deparse($kid, 0), $cx);
     } elsif (is_scalar $kid) {
        my $str = $self->deparse($kid, 0);
        if ($str =~ /^\$([^\w\d])\z/) {
@@ -4352,7 +4358,7 @@ sub pp_split {
     } elsif (!ref($replroot) and $replroot > 0) {
        $gv = $self->padval($replroot);
     }
-    $ary = $self->stash_variable('@', $self->gv_name($gv)) if $gv;
+    $ary = $self->stash_variable('@', $self->gv_name($gv), $cx) if $gv;
 
     for (; !null($kid); $kid = $kid->sibling) {
        push @exprs, $self->deparse($kid, 6);

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 18ab953..ab50b5a 100644 (file)
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -208,6 +208,16 @@ sub BEGIN {
 }
 EOCODF
 
+# [perl #93990]
+is($deparse->coderef2text(sub{ print "@{*}" }),
+q<{
+    print "@{*}";
+}>, 'curly around to interpolate "@{*}"');
+is($deparse->coderef2text(sub{ print "@{-}" }),
+q<{
+    print "@-";
+}>, 'no need to curly around to interpolate "@-"');
+
 done_testing();
 
 __DATA__