From 465e907d5e49b19a8c3ce20b73ae0740d93c99ee Mon Sep 17 00:00:00 2001
From: Nicolas R <nicolas@atoomic.org>
Date: Mon, 17 Jan 2022 21:44:53 +0000
Subject: [PATCH] Community::Prototypes can detect explicit :prototype

Fix #44

When using function signatures, prototypes can be set using
the ': prototype'.
With this change we can now detect explicit usage of prototype.
---
 .../Critic/Policy/Community/Prototypes.pm     | 62 ++++++++++++-------
 t/Community/Prototypes.run                    | 20 ++++++
 2 files changed, 60 insertions(+), 22 deletions(-)

diff --git a/lib/Perl/Critic/Policy/Community/Prototypes.pm b/lib/Perl/Critic/Policy/Community/Prototypes.pm
index 594683b..0f8fa91 100644
--- a/lib/Perl/Critic/Policy/Community/Prototypes.pm
+++ b/lib/Perl/Critic/Policy/Community/Prototypes.pm
@@ -26,28 +26,46 @@ sub default_themes { 'community' }
 sub applies_to { 'PPI::Document' }
 
 sub violates {
-	my ($self, $elem) = @_;
-
-	# Check if signatures are enabled
-	my $includes = $elem->find('PPI::Statement::Include') || [];
-	foreach my $include (@$includes) {
-	  next unless $include->type eq 'use';
-	  return () if $include->pragma eq 'feature' and $include =~ m/\bsignatures\b/;
-	  return () if $include->pragma eq 'experimental' and $include =~ m/\bsignatures\b/;
-	  return () if $include->module eq 'Mojo::Base' and $include =~ m/-signatures\b/;
-	  return () if $include->module eq 'Mojolicious::Lite' and $include =~ m/-signatures\b/;
-	  return () if exists $self->{_signature_enablers}{$include->module};
-	}
-	
-	my $prototypes = $elem->find('PPI::Token::Prototype') || [];
-	my @violations;
-	foreach my $prototype (@$prototypes) {
-		# Empty prototypes and prototypes containing & can be useful
-		next if $prototype->prototype eq '' or $prototype->prototype =~ /&/;
-		push @violations, $self->violation(DESC, EXPL, $prototype);
-	}
-	
-	return @violations;
+    my ($self, $elem) = @_;
+
+    my $use_signatures;
+
+    # Check if signatures are enabled
+    my $includes = $elem->find('PPI::Statement::Include') || [];
+    foreach my $include (@$includes) {
+        next unless $include->type eq 'use';
+        $use_signatures = 1 if $include->pragma eq 'feature'           and $include =~ m/\bsignatures\b/;
+        $use_signatures = 1 if $include->pragma eq 'experimental'      and $include =~ m/\bsignatures\b/;
+        $use_signatures = 1 if $include->module eq 'Mojo::Base'        and $include =~ m/-signatures\b/;
+        $use_signatures = 1 if $include->module eq 'Mojolicious::Lite' and $include =~ m/-signatures\b/;
+        $use_signatures = 1 if exists $self->{_signature_enablers}{ $include->module };
+    }
+
+    my @violations;
+
+    if ( !$use_signatures ) {
+        my $prototypes = $elem->find('PPI::Token::Prototype') || [];
+        foreach my $prototype (@$prototypes) {
+
+            # Empty prototypes and prototypes containing & can be useful
+            next if $prototype->prototype eq '' or $prototype->prototype =~ /&/;
+            push @violations, $self->violation( DESC, EXPL, $prototype );
+        }
+    }
+
+    my $subs = $elem->find('PPI::Statement::Sub') || [];
+
+    foreach my $sub (@$subs) {
+        my $attributes = $sub->find('PPI::Token::Attribute') || [];
+        foreach my $attr (@$attributes) {
+            my $c = $attr->content;
+            next unless defined $c && $c =~ qr{^\Qprototype(\E};
+            push @violations, $self->violation( DESC, EXPL, $attr );
+            last;
+        }
+    }
+
+    return @violations;
 }
 
 1;
diff --git a/t/Community/Prototypes.run b/t/Community/Prototypes.run
index fc75a25..1ec945d 100644
--- a/t/Community/Prototypes.run
+++ b/t/Community/Prototypes.run
@@ -57,3 +57,23 @@ sub foo () { ... }
 ## cut
 
 sub foo (&;@) { ... }
+
+## name ExplicitPrototypes
+## failures 1
+## cut
+
+sub foo : prototype($$) { ... }
+
+## name ExplicitPrototypesWithSig
+## failures 1
+## cut
+
+use experimental 'signatures';
+sub foo : prototype($$) { ... }
+
+## name MojoSignaturePrototypes
+## failures 1
+## cut
+
+use Mojo::Base -base, -signatures;
+sub bar : prototype($@) { ... }
\ No newline at end of file