From 6a9d009e69dd224a54be0dcbcc2aeaccb774078b Mon Sep 17 00:00:00 2001
From: "Paul \"LeoNerd\" Evans" <leonerd@leonerd.org.uk>
Date: Wed, 27 Nov 2024 17:20:26 +0000
Subject: [PATCH] lib/B/Deparse.pm: Don't get upset by OP_METHSTART in method
 subs

When encountering a `method` sub under `use feature 'class'`, we need to
skip over and ignore the `OP_METHSTART` at the beginning, so we can
still safely handle the signature ops. We also need to emit the
declaration under a `method` keyword, rather than a `sub`.
---
 lib/B/Deparse.pm | 37 ++++++++++++++++++++++++++-----------
 lib/B/Deparse.t  | 15 ++++++++++++++-
 2 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 6e3389373695..ce2ec367940c 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -7,7 +7,7 @@
 # This is based on the module of the same name by Malcolm Beattie,
 # but essentially none of his code remains.
 
-package B::Deparse 1.80;
+package B::Deparse 1.81;
 use strict;
 use Carp;
 use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
@@ -28,7 +28,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
          OPpARG_IF_UNDEF OPpARG_IF_FALSE
 	 SVf_IOK SVf_NOK SVf_ROK SVf_POK SVf_FAKE SVs_RMG SVs_SMG
 	 SVs_PADTMP
-         CVf_NOWARN_AMBIGUOUS CVf_LVALUE
+         CVf_NOWARN_AMBIGUOUS CVf_LVALUE CVf_IsMETHOD
 	 PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE
 	 PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED PMf_EXTENDED_MORE
 	 PADNAMEf_OUTER PADNAMEf_OUR PADNAMEf_TYPED
@@ -480,7 +480,8 @@ sub next_todo {
 	# XXX We would do $self->keyword("sub"), but ‘my CORE::sub’
 	#     doesn’t work and ‘my sub’ ignores a &sub in scope.  I.e.,
 	#     we have a core bug here.
-	push @text, "sub " . substr $name->PVX, 1;
+	my $kw = $cv ? $self->kw_sub_or_method($cv) : "sub";
+	push @text, "$kw " . substr $name->PVX, 1;
 	if ($cv) {
 	    # my sub foo { }
 	    push @text,  " " . $self->deparse_sub($cv);
@@ -554,7 +555,7 @@ sub next_todo {
         } elsif (defined $stash) {
             $name =~ s/^\Q$stash\E::(?!\z|.*::)//;
         }
-	my $ret = "$pragmata${p}${l}" . $self->keyword("sub") . " $name "
+	my $ret = "$pragmata${p}${l}" . $self->keyword($self->kw_sub_or_method($cv)) . " $name "
 	      . $self->deparse_sub($cv);
 	$self->{'subs_declared'}{$name} = 1;
 	return $ret;
@@ -1304,6 +1305,12 @@ sub deparse_argops {
 }
 
 
+sub kw_sub_or_method {
+    my $self = shift;
+    my $cv = shift;
+    return ($cv->CvFLAGS & CVf_IsMETHOD) ? "method" : "sub";
+}
+
 # Deparse a sub. Returns everything except the 'sub foo',
 # e.g.  ($$) : method { ...; }
 # or    : prototype($$) lvalue ($a, $b) { ...; };
@@ -1329,10 +1336,13 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
             $proto = $myproto;
         }
     }
-    if ($cv->CvFLAGS & (CVf_NOWARN_AMBIGUOUS|CVf_LOCKED|CVf_LVALUE|CVf_ANONCONST)) {
-        push @attrs, "lvalue" if $cv->CvFLAGS & CVf_LVALUE;
-        push @attrs, "method" if $cv->CvFLAGS & CVf_NOWARN_AMBIGUOUS;
-        push @attrs, "const"  if $cv->CvFLAGS & CVf_ANONCONST;
+    my $cv_flags = $cv->CvFLAGS;
+    my $is_method = $cv_flags & CVf_IsMETHOD;
+
+    if ($cv_flags & (CVf_NOWARN_AMBIGUOUS|CVf_LOCKED|CVf_LVALUE|CVf_ANONCONST)) {
+        push @attrs, "lvalue" if $cv_flags & CVf_LVALUE;
+        push @attrs, "method" if $cv_flags & CVf_NOWARN_AMBIGUOUS and !$is_method;
+        push @attrs, "const"  if $cv_flags & CVf_ANONCONST;
     }
 
     local($self->{'curcv'}) = $cv;
@@ -1351,6 +1361,10 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
         my $is_list = ($lineseq->name eq "lineseq");
         my $firstop = $is_list ? $lineseq->first : $lineseq;
 
+        if ($is_method and $firstop->name eq "methstart") {
+            $firstop = $firstop->sibling;
+        }
+
         # Try to deparse first subtree as a signature if possible.
         # Top of signature subtree has an ex-argcheck as a placeholder
         if (    $has_sig
@@ -2812,8 +2826,9 @@ sub pp_refgen {
 
 sub e_anoncode {
     my ($self, $info) = @_;
-    my $text = $self->deparse_sub($info->{code});
-    return $self->keyword("sub") . " $text";
+    my $cv = $info->{code};
+    my $text = $self->deparse_sub($cv);
+    return $self->keyword($self->kw_sub_or_method($cv)) . " $text";
 }
 
 sub pp_anoncode {
@@ -5645,7 +5660,7 @@ sub const {
 		 $self->{curcv}->object_2svref == $ref->object_2svref) {
 		return $self->keyword("__SUB__");
 	    }
-	    return "sub " . $self->deparse_sub($ref);
+	    return $self->kw_sub_or_method($ref) . " " . $self->deparse_sub($ref);
 	}
 	if ($class ne 'SPECIAL' and $ref->FLAGS & SVs_SMG) {
 	    for (my $mg = $ref->MAGIC; $mg; $mg = $mg->MOREMAGIC) {
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 20adbca4743b..c39481bbe0e9 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -13,7 +13,7 @@ BEGIN {
 use warnings;
 use strict;
 
-my $tests = 52; # not counting those in the __DATA__ section
+my $tests = 53; # not counting those in the __DATA__ section
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -571,6 +571,19 @@ is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ],
     "package Foo;\nsub f {\n    1;\n}\nsub BEGIN {\n    *Bar::f = \\&f;\n}\n",
     "sub glob alias in separate package shouldn't impede emitting original sub";
 
+# method declarations (GH#22777)
+like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ],
+    prog => <<'EOF',
+        use feature qw( class signatures );
+        class C {
+            field $x;
+            method m () { $x++ }
+        }
+EOF
+    ),
+    qr/ +method m \(\) \{\n +\$x\+\+;\n +\}/,
+    "feature class method deparses as method";
+
 
 done_testing($tests);