restore deparsing style for \&foo

When deparsing a reference to a sub in the current package, other than in
a call expression, with "use strict 'vars'" in effect and no lexical sub
of the same name in scope, commit dd6661605fe0a54c602f2e55f875acfdcd330b79
accidentally changed the deparsing from "&main::foo" to "&foo".
Both deparsings are correct, and the short one arguably preferable.
In fact, the deparsing was originally of the short form, but changed to
the long form (probably accidentally) in Perl 5.21.7, when the deparser
started adding the package to distinguish package subs from lexical subs
of the same name.  Nevertheless, it was not the intention to change this
output in that edit, and it broke a CPAN module's tests.  Consequently,
this commit restores the long-form deparsing in this case.

2 files changed, 32 insertions, 2 deletions

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index cc439ae182..33b9b1e283 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -1878,7 +1878,7 @@ sub maybe_qualify {
 	if
 	    $name =~ /^(?!\d)\w/         # alphabetic
 	 && $v    !~ /^\$[ab]\z/	 # not $a or $b
-	 && $v =~ /\A[\$\@\%]/           # scalar, array, or hash
+	 && $v =~ /\A[\$\@\%\&]/         # scalar, array, hash, or sub
 	 && !$globalnames{$name}         # not a global name
 	 && $self->{hints} & $strict_bits{vars}  # strict vars
 	 && !$self->lex_in_scope($v,1)   # no "our"
@@ -4883,7 +4883,7 @@ sub pp_entersub {
 	    $proto = $cv->PV if $cv->FLAGS & SVf_POK;
 	}
 	$simple = 1; # only calls of named functions can be prototyped
-	$kid = $self->maybe_qualify("&", $self->gv_name($gv));
+	$kid = $self->maybe_qualify("!", $self->gv_name($gv));
 	my $fq;
 	# Fully qualify any sub name that conflicts with a lexical.
 	if ($self->lex_in_scope("&$kid")
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 27d1b3a2c2..f8da6460e8 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -2864,6 +2864,7 @@ print %CORE::foo, %CORE::foo::bar;
 print $CORE::foo{'a'}, $CORE::foo::bar{'a'};
 print &CORE::foo, &CORE::foo::bar;
 print &CORE::foo(), &CORE::foo::bar();
+print \&CORE::foo, \&CORE::foo::bar;
 print *CORE::foo, *CORE::foo::bar;
 print stat CORE::foo::, stat CORE::foo::bar;
 print CORE::foo:: 1;
@@ -2878,6 +2879,7 @@ print %foo, %foo::, %foo::::;
 print $foo{'a'}, $foo::{'a'}, $foo::::{'a'};
 print &foo, &foo::, &foo::::;
 print &foo(), &foo::(), &foo::::();
+print \&foo, \&foo::, \&foo::::;
 print *foo, *foo::, *foo::::;
 print stat Foo, stat Foo::::;
 print Foo 1;
@@ -2891,6 +2893,7 @@ print %CORE, %CORE::, %CORE::::;
 print $CORE{'a'}, $CORE::{'a'}, $CORE::::{'a'};
 print &CORE, &CORE::, &CORE::::;
 print &CORE(), &CORE::(), &CORE::::();
+print \&CORE, \&CORE::, \&CORE::::;
 print *CORE, *CORE::, *CORE::::;
 print stat CORE, stat CORE::::;
 print CORE 1;
@@ -2901,7 +2904,34 @@ print %CORE::foo, %CORE::foo::, %CORE::foo::::;
 print $CORE::foo{'a'}, $CORE::foo::{'a'}, $CORE::foo::::{'a'};
 print &CORE::foo, &CORE::foo::, &CORE::foo::::;
 print &CORE::foo(), &CORE::foo::(), &CORE::foo::::();
+print \&CORE::foo, \&CORE::foo::, \&CORE::foo::::;
 print *CORE::foo, *CORE::foo::, *CORE::foo::::;
 print stat CORE::foo::, stat CORE::foo::::;
 print CORE::foo:: 1;
 print CORE::foo:::: 2;
+####
+# \&foo
+my sub foo {
+    1;
+}
+no strict 'vars';
+print \&main::foo;
+print \&{foo};
+print \&bar;
+use strict 'vars';
+print \&main::foo;
+print \&{foo};
+print \&main::bar;
+####
+# exists(&foo)
+my sub foo {
+    1;
+}
+no strict 'vars';
+print exists &main::foo;
+print exists &{foo};
+print exists &bar;
+use strict 'vars';
+print exists &main::foo;
+print exists &{foo};
+print exists &main::bar;