add policy for sigantures with @_

.github/workflows/linux.yml

@@ -17,8 +17,8 @@ jobs:
       fail-fast: false
       matrix:
         cip_tag:
-          - static
-          - "5.37"
+          - "5.39"
+          - "5.38"
           - "5.36"
           - "5.34"
           - "5.32"

Changes

@@ -1,6 +1,7 @@
 Revision history for {{$dist->name}}
 
 {{$NEXT}}
+  - (ProhibitSignaturesAndAtUnderscore) Added new policy (gh#6)
 
 0.05      2024-02-10 05:49:37 -0700
   - (ProhibitSpecificModules) Added new policy (gh#5)

author.yml

@@ -20,3 +20,4 @@ pod_coverage:
     - Perl::Critic::Policy::Plicease::ProhibitUnicodeDigitInRegexp
     - Perl::Critic::Policy::Plicease::ProhibitLeadingZeros
     - Perl::Critic::Policy::Plicease::ProhibitSpecificModules
+    - Perl::Critic::Policy::Plicease::ProhibitSignaturesAndAtUnderscore

lib/Perl/Critic/Policy/Plicease/ProhibitSignaturesAndAtUnderscore.pm

@@ -0,0 +1,97 @@
+package Perl::Critic::Policy::Plicease::ProhibitSignaturesAndAtUnderscore;
+
+use strict;
+use warnings;
+use 5.010001;
+use Perl::Critic::Utils qw( $SEVERITY_HIGH );
+use base qw( Perl::Critic::Policy );
+
+# ABSTRACT: Prohibit the use of @_ in subroutine using signatures
+# VERSION
+
+=head1 SYNOPSIS
+
+ sub foo ($$) { my($a,$b) = @_; }                                    # ok
+ use experimental qw( signatures ); foo ($a, $b) { my($c,$d) = @_; } # not ok
+
+=head1 DESCRIPTION
+
+When signatures were made non-experimental, C<@_> used in a subroutine that used signatures was kept as
+experimental.  This is a problem for a few reasons, for one you don't see the experimental warning
+specific to C<@_> unless you are running a Perl after signatures were made non-experimental, for another
+as of Perl 5.39.10 this is still experimental.
+
+=head1 AFFILIATION
+
+None.
+
+=head1 CONFIGURATION
+
+This policy can be configured to recognize additional modules as enabling the signatures feature, by
+putting an entry in a .perlcriticrc file like this:
+
+ [Community::Prototypes]
+ signature_enablers = Plicease::ProhibitSignaturesAndAtUnderscore
+
+=head1 CAVEATS
+
+This module assumes that "prototypes" detected in a source file that has signatures enabled are actually
+subroutine signatures.  This is because through static analysis alone it is not possible to determine if
+a "prototype" is really a prototype and not a signature.  There thus may be false negatives/positives.
+
+=cut
+
+use constant DESC => 'Using @_ in a function with signatures';
+use constant EXPL => 'The use of @_ in a subroutine that is also using subroutine signatures is experimental.';
+
+sub supported_parameters {
+  return ({
+    name        => 'signature_enablers',
+    description => 'Non-standard modules to recognize as enabling signatures',
+    behavior    => 'string list',
+  });
+}
+
+sub default_severity { $SEVERITY_HIGH }
+sub default_themes { () }
+sub applies_to { 'PPI::Document' }
+
+sub violates {
+  my($self, $elem) = @_;
+
+  my $has_signatures = 0;
+
+  # Check if signatures are enabled
+  my $includes = $elem->find('PPI::Statement::Include') || [];
+  foreach my $include (@$includes) {
+    next unless $include->type eq 'use';
+
+    if(($include->version and version->parse($include->version) >= version->parse('v5.36'))
+    || ($include->pragma eq 'feature' and $include =~ m/\bsignatures\b/)
+    || ($include->pragma eq 'experimental' and $include =~ m/\bsignatures\b/)
+    || ($include->module eq 'Mojo::Base' and $include =~ m/-signatures\b/)
+    || ($include->module eq 'Mojolicious::Lite' and $include =~ m/-signatures\b/)
+    || (exists $self->{_signature_enablers}{$include->module})) {
+      $has_signatures = 1;
+    }
+  }
+
+  my @violations;
+
+  if($has_signatures) {
+
+    my $subs = $elem->find('PPI::Statement::Sub') || [];
+    foreach my $sub (@$subs) {
+      next unless defined $sub->prototype;
+      my $symbols = $sub->find('PPI::Token::Symbol') || [];
+      foreach my $symbol (@$symbols) {
+        next unless $symbol->symbol eq '@_';
+        push @violations, $self->violation(DESC, EXPL, $symbol);
+      }
+    }
+  }
+
+  return @violations;
+}
+
+1;

t/Plicease/ProhibitSignaturesAndAtUnderscore.run

@@ -0,0 +1,27 @@
+## name Bad1
+## failures 1
+## cut
+
+use experimental qw( signatures );
+
+sub foo ($a, $b) {
+  my @x = @_;
+}
+
+## name Bad2
+## failures 1
+## cut
+
+use experimental qw( signatures );
+
+sub foo ($a) {
+  my $x = $_[0];
+}
+
+## name Prototype
+## failures 0
+## cut
+
+sub foo ($$) {
+  my @x = @_;
+}

t/perl_critic_policy_plicease_prohibitsignaturesandunderscore.t

@@ -0,0 +1,6 @@
+use Test2::V0 -no_srand => 1;
+use Test::Perl::Critic::Policy qw( all_policies_ok );
+
+all_policies_ok( -policies => [ 'Plicease::ProhibitSignaturesAndAtUnderscore' ] );
+
+done_testing