Deparse: Restore proto checks for coderef2text

This fixes #123435 (I hope).

Before v5.21.6-485-gf2279a6, B::Deparse, when deparsing sub calls,
would look in the stash for a sub with a prototype, and use that
prototype for deparsing.  (It would only do this for subs that it
itself is not going to deparse.)  That caused this to deparse
incorrectly:

BEGIN {
   require Test::More;
   is("foo", "foo");
}

Because of the presence of the prototyped &main::is by the time
B::Deparse is invoked, it would deparse the is() sub call without
parentheses, resulting in invalid code.

So I changed it to trust only those subs that it has already deparsed.

Now, with coderef2text, B::Deparse doesn’t deparse any subs except the
one passed to it.  So *all* prototype sub calls turn into &foo, break-
ing CPAN tests that expect otherwise.  While such tests could be con-
sidered too sensitive, I don’t think that this is necessarily a sane
default for coderef2text.

Ideally we should provide the option to tell coderef2text which
subs to trust, the default being to trust all of them.  But for
now I will just implement that default, which means reverting
v5.21.6-485-gf2279a6 *for coderef2text*, but not when deparsing the
main program.

2 files changed, 19 insertions, 0 deletions

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 5d64f55010..4b50f897a8 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -234,6 +234,10 @@ BEGIN {
 
 # Object fields:
 #
+# in_coderef2text:
+# True when deparsing via $deparse->coderef2text; false when deparsing the
+# main program.
+#
 # avoid_local:
 # (local($a), local($b)) and local($a, $b) have the same internal
 # representation but the short form looks better. We notice we can
@@ -963,6 +967,7 @@ sub coderef2text {
     croak "Usage: ->coderef2text(CODEREF)" unless UNIVERSAL::isa($sub, "CODE");
 
     $self->init();
+    local $self->{in_coderef2text} = 1;
     return $self->indent($self->deparse_sub(svref_2object($sub)));
 }
 
@@ -4381,6 +4386,17 @@ sub pp_entersub {
     # Doesn't matter how many prototypes there are, if
     # they haven't happened yet!
     my $declared = exists $self->{'subs_declared'}{$kid};
+    if (not $declared and $self->{'in_coderef2text'}) {
+	no strict 'refs';
+	no warnings 'uninitialized';
+	$declared =
+	       (
+		 defined &{ ${$self->{'curstash'}."::"}{$kid} }
+		 && !exists
+		     $self->{'subs_deparsed'}{$self->{'curstash'}."::".$kid}
+		 && defined prototype $self->{'curstash'}."::".$kid
+	       );
+    }
     if (!$declared && defined($proto)) {
 	# Avoid "too early to check prototype" warning
 	($amper, $proto) = ('&');
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 0ad4d00416..7fdf12506e 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -1907,6 +1907,9 @@ foo(bar(),baz());
 package prototest;
 &foo(scalar bar(), scalar baz());
 ####
+# coderef2text and prototyped sub calls [perl #123435]
+is 'foo', 'oo';
+####
 # ensure aelemfast works in the range -128..127 and that there's no
 # funky edge cases
 my $x;