[perl #91416] Deparse open("blah blah blah") properly

‘open bareword’ compiles down to

  open
    `--+--pushmark
       `--gv

whereas ‘open "string"’ compiles down to

  open
    `--+--pushmark
       `--rv2gv
            `----gv

the same as ‘open *glob’.

B::Deparse was deparsing the child of the rv2gv, in order to deparse
things like open(my $fh...) as they were entered, instead of
open(*my $fh), which wouldn’t work.  gvops were being deparsed as
the name.  But this meant that ‘open "open"’ would be deparsed as
‘open open’, which does something different, ‘open’ being a keyword.
It also did that with ‘open '%^$^$%'’, which would deparse without the
quotation marks.

This commit changes the deparsing of filehandle-op -> rv2gv -> gv,
by keeping the explicit * present if the name of the gv is a valid
identifier  (so open("foo") and open(*foo), which compile identi-
cally, both come out as open(*foo)), or by using quotation marks if
it is not.

2 files changed, 33 insertions, 4 deletions

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 6639c4df4f..6a4d8cb78a 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -1252,9 +1252,10 @@ BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC",
 sub gv_name {
     my $self = shift;
     my $gv = shift;
+    my $raw = shift;
 Carp::confess() unless ref($gv) eq "B::GV";
     my $stash = $gv->STASH->NAME;
-    my $name = $gv->SAFENAME;
+    my $name = $raw ? $gv->NAME : $gv->SAFENAME;
     if ($stash eq 'main' && $name =~ /^::/) {
 	$stash = '::';
     }
@@ -1267,7 +1268,7 @@ Carp::confess() unless ref($gv) eq "B::GV";
     } else {
 	$stash = $stash . "::";
     }
-    if ($name =~ /^(\^..|{)/) {
+    if (!$raw and $name =~ /^(\^..|{)/) {
         $name = "{$name}";       # ${^WARNING_BITS}, etc and ${
     }
     return $stash . $name;
@@ -2369,6 +2370,23 @@ sub pp_andassign { logassignop(@_, "&&=") }
 sub pp_orassign  { logassignop(@_, "||=") }
 sub pp_dorassign { logassignop(@_, "//=") }
 
+sub rv2gv_or_string {
+    my($self,$op) = @_;
+    if ($op->name eq "gv") { # could be open("open") or open("###")
+	my $name = $self->gv_name($self->gv_or_padgv($op), 1);
+	if ($name =~ /^(?:\S|(?!\d)[\ca-\cz]?\w*|\d+)\z/) {
+	    $name =~ s/^([\ca-\cz])/'^'.($1|'@')/e;
+	    $name =~ /^(\^..|{)/ ? "*{$name}" : "*$name";
+	}
+	else {
+	    single_delim("q", "'", $name);
+	}
+    }
+    else {
+	$self->deparse($op, 6);
+    }
+}
+
 sub listop {
     my $self = shift;
     my($op, $cx, $name, $kid, $nollafr) = @_;
@@ -2391,7 +2409,7 @@ sub listop {
     if (defined $proto
 	&& $proto =~ /^;?\*/
 	&& $kid->name eq "rv2gv" && !($kid->private & OPpLVAL_INTRO)) {
-	$first = $self->deparse($kid->first, 6);
+	$first = $self->rv2gv_or_string($kid->first);
     }
     else {
 	$first = $self->deparse($kid, 6);
@@ -2405,7 +2423,7 @@ sub listop {
     $kid = $kid->sibling;
     if (defined $proto && $proto =~ /^\*\*/ && $kid->name eq "rv2gv"
 	 && !($kid->private & OPpLVAL_INTRO)) {
-	push @exprs, $self->deparse($kid->first, 6);
+	push @exprs, $first = $self->rv2gv_or_string($kid->first);
 	$kid = $kid->sibling;
     }
     for (; !null($kid); $kid = $kid->sibling) {
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 22f2cb533e..be9cbb6d29 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -891,6 +891,17 @@ $_ = ($a xor not +($1 || 2) ** 2);
 open local *FH;
 pipe local *FH, local *FH;
 ####
+# [perl #91416] open "string"
+open 'open';
+open '####';
+open '^A';
+open "\ca";
+>>>>
+open *open;
+open '####';
+open '^A';
+open *^A;
+####
 # [perl #74740] -(f()) vs -f()
 $_ = -(f());
 ####