Login
RT #79138: RequireArgUnpacking confused by @_ in finally{}
authorTom Wyant <harryfmudd@comcast.net>
Fri, 24 Aug 2012 03:22:08 +0000 (03:22 +0000)
committerTom Wyant <harryfmudd@comcast.net>
Fri, 24 Aug 2012 03:22:08 +0000 (03:22 +0000)
This policy contains some logic for testing the size of the argument
list -- basically allowing the combinations '$something == @_', '@_ ==
$something', '$something != @_, and '@_ != $something'.

My read on the ticket is that finally{} is not involved, but that the
requestor is asking for the size test logic to be more comprehensive.

This I have done, adding the other comparison operators, plus boolean
operators, plus logic to handle suffix conditionals.

The .run file has an added test, though the test does not cover the
Cartesian product of all the possibilities.

Changes
lib/Perl/Critic/Policy/Subroutines/RequireArgUnpacking.pm
t/Subroutines/RequireArgUnpacking.run

diff --git a/Changes b/Changes
index 5359530..652632a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 [X.XXX] Released on XXXX-XX-XX
 
+     Policy Changes:
+     * Subroutines::RequireArgUnpacking: Most tests of the size of @_
+       are now allowed.  RT #79138
      Other Changes:
      * Modernized our usage of Exporter.  See RT #75300.  
        Thanks to Olivier MenguĂ© for the patch.
index e4238e4..554991d 100644 (file)
@@ -20,7 +20,7 @@ use List::Util qw(first);
 use List::MoreUtils qw(uniq any);
 
 use Perl::Critic::Utils qw<
-    :booleans :characters :severities words_from_string
+    :booleans :characters hashify :severities words_from_string
 >;
 use base 'Perl::Critic::Policy';
 
@@ -169,23 +169,78 @@ sub _is_size_check {
     my $prev = $magic->sprevious_sibling;
     my $next = $magic->snext_sibling;
 
-    return $TRUE
-        if
-                not $next
-            and $prev
-            and $prev->isa('PPI::Token::Operator')
-            and (q<==> eq $prev->content() or q<!=> eq $prev->content());
+    if ( $prev || $next ) {
+
+        return $TRUE
+            if _legal_before_size_check( $prev )
+                and _legal_after_size_check( $next );
+    }
+
+    my $parent = $magic;
+    {
+        $parent = $parent->parent()
+            or return;
+        $prev = $parent->sprevious_sibling();
+        $next = $parent->snext_sibling();
+        $prev
+            or $next
+            or redo;
+    }   # until ( $prev || $next );
 
     return $TRUE
-        if
-                not $prev
-            and $next
-            and $next->isa('PPI::Token::Operator')
-            and (q<==> eq $next->content() or q<!=> eq $next->content());
+        if $parent->isa( 'PPI::Structure::Condition' );
 
     return;
 }
 
+{
+
+    Readonly::Hash my %LEGAL_NEXT_OPER => hashify(
+        qw{ && || == != > >= < <= and or } );
+
+    Readonly::Hash my %LEGAL_NEXT_STRUCT => hashify( qw{ ; } );
+
+    sub _legal_after_size_check {
+        my ( $next ) = @_;
+
+        $next
+            or return $TRUE;
+
+        $next->isa( 'PPI::Token::Operator' )
+            and return $LEGAL_NEXT_OPER{ $next->content() };
+
+        $next->isa( 'PPI::Token::Structure' )
+            and return $LEGAL_NEXT_STRUCT{ $next->content() };
+
+        return;
+    }
+}
+
+{
+
+    Readonly::Hash my %LEGAL_PREV_OPER => hashify(
+        qw{ && || ! == != > >= < <= and or not } );
+
+    Readonly::Hash my %LEGAL_PREV_WORD => hashify(
+        qw{ if unless } );
+
+    sub _legal_before_size_check {
+        my ( $prev ) = @_;
+
+        $prev
+            or return $TRUE;
+
+        $prev->isa( 'PPI::Token::Operator' )
+            and return $LEGAL_PREV_OPER{ $prev->content() };
+
+        $prev->isa( 'PPI::Token::Word' )
+            and return $LEGAL_PREV_WORD{ $prev->content() };
+
+        return;
+    }
+
+}
+
 sub _is_postfix_foreach {
     my ($magic) = @_;
 
index 577d03f..ef0dcf4 100644 (file)
@@ -306,6 +306,123 @@ sub foo {
 
 #-----------------------------------------------------------------------------
 
+## name Allow tests (rt #79138)
+## failures 0
+## cut
+
+sub foo {
+    my ( $self, $arg ) = @_;
+
+    if ( @_ ) {
+        say 'Some arguments';
+    }
+    unless ( ! @_ ) {
+        say 'Some arguments';
+    }
+    unless ( not @_ ) {
+        say 'Some arguments';
+    }
+    say 'Some arguments'
+        if @_;
+    say 'Some arguments'
+        if ( @_ );
+    say 'Some arguments'
+        unless ! @_;
+    say 'Some arguments'
+        unless ( ! @_ );
+    say 'Some arguments'
+        unless not @_;
+    say 'Some arguments'
+        unless ( not @_ );
+    @_
+        and say 'Some arguments';
+    ! @_
+        or say 'Some arguments';
+    not @_
+        or say 'Some arguments';
+
+    unless ( @_ ) {
+        say 'No arguments';
+    }
+    if ( ! @_ ) {
+        say 'No arguments';
+    }
+    if ( not @_ ) {
+        say 'No arguments';
+    }
+    say 'No arguments'
+        unless @_;
+    say 'No arguments'
+        unless ( @_ );
+    say 'No arguments'
+        if ! @_;
+    say 'No arguments'
+        if ( ! @_ );
+    say 'No arguments'
+        if not @_;
+    say 'No arguments'
+        if ( not @_ );
+    @_
+        or say 'No arguments';
+    ! @_
+        and say 'No arguments';
+    not @_
+        and say 'No arguments';
+
+    if ( @_ == 2 ) {
+        say 'Two arguments';
+    }
+    if ( 2 == @_ ) {
+        say 'Two arguments';
+    }
+    @_ == 2
+        and say 'Two arguments';
+    2 == @_
+        and say 'Two arguments';
+    say 'Two arguments'
+        if @_ == 2;
+    say 'Two arguments'
+        if ( @_ == 2 );
+    unless ( @_ != 2 ) {
+        say 'Two arguments';
+    }
+    unless ( 2 != @_ ) {
+        say 'Two arguments';
+    }
+    say 'Two arguments'
+        unless @_ != 2;
+    say 'Two arguments'
+        unless ( @_ != 2 );
+
+    if ( @_ != 2 ) {
+        say 'Not two arguments';
+    }
+    if ( 2 != @_ ) {
+        say 'Not two arguments';
+    }
+    @_ != 2
+        and say 'Not two arguments';
+    2 != @_
+        and say 'Not two arguments';
+    say 'Not two arguments'
+        if @_ != 2;
+    say 'Not two arguments'
+        if ( @_ != 2 );
+    unless ( @_ == 2 ) {
+        say 'Not two arguments';
+    }
+    unless ( 2 == @_ ) {
+        say 'Not two arguments';
+    }
+    say 'Not two arguments'
+        unless @_ == 2;
+    say 'Not two arguments'
+        unless ( @_ == 2 );
+
+}
+
+#-----------------------------------------------------------------------------
+
 ##############################################################################
 #      $URL$
 #     $Date$