Login
RT #69489 - ErrorHandling::RequireCheckingReturnValueOfEval false
authorTom Wyant <harryfmudd@comcast.net>
Fri, 15 Jul 2011 21:09:27 +0000 (21:09 +0000)
committerTom Wyant <harryfmudd@comcast.net>
Fri, 15 Jul 2011 21:09:27 +0000 (21:09 +0000)
positive

The issue is that the subject policy does not accept grep { eval ... }.
The failing code provided in the ticket was
    grep { ! eval "require $_" } @packages;
After a bit of thought (enough, I hope!) I decided that this was the
moral equivalent of
    foreach ( @packages ) {
        eval "require $_" and next;
...
    }
which is acceptable to this policy. So ...

This modification looks for both
    grep { eval ... } ...
and
    grep eval ... , ...
though it does not look quite as hard for the latter.

Changes
lib/Perl/Critic/Policy/ErrorHandling/RequireCheckingReturnValueOfEval.pm
t/ErrorHandling/RequireCheckingReturnValueOfEval.run

diff --git a/Changes b/Changes
index 875ebac..c58c35e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -5,6 +5,8 @@ Next release, whenever it is:
       RT #68498.
     * ControlStructures::ProhibitMutatingListFunctions now understands that
       tr///r (introduced in 5.13.7) does not change its operand.
+    * ErrorHandling::RequireCheckingReturnValueOfEval now allows things
+      like grep { eval $_ }. RT #69489.
     * RegularExpressions::ProhibitEnumeratedClasses no longer thinks
       that [A-Za-z_] matches \w. RT #69322.
     * Subroutines::ProhibitManyArgs now recognizes '+' as a prototype
index c51ff1a..ff60068 100644 (file)
@@ -15,7 +15,8 @@ use Readonly;
 
 use Scalar::Util qw< refaddr >;
 
-use Perl::Critic::Utils qw< :booleans :characters :severities hashify >;
+use Perl::Critic::Utils qw< :booleans :characters :severities hashify
+    precedence_of >;
 use base 'Perl::Critic::Policy';
 
 our $VERSION = '1.116';
@@ -32,6 +33,8 @@ Readonly::Hash my %BOOLEAN_OPERATORS => hashify qw< || && // or and >;
 Readonly::Hash my %POSTFIX_OPERATORS =>
     hashify qw< for foreach if unless while until >;
 
+Readonly::Scalar my $PRECEDENCE_OF_EQUALS => precedence_of( q{=} );
+
 #-----------------------------------------------------------------------------
 
 sub supported_parameters { return ()                 }
@@ -57,6 +60,8 @@ sub violates {
             $following,
         );
 
+    return if _scan_backwards_for_grep( $elem );    # RT 69489
+
     if ( $following and $following->isa('PPI::Token::Operator') ) {
         return if $BOOLEAN_OPERATORS{ $following->content() };
         return if q{?} eq $following->content;
@@ -253,6 +258,31 @@ sub _is_in_postfix_expression {
 
 #-----------------------------------------------------------------------------
 
+sub _scan_backwards_for_grep {
+    my ( $elem ) = @_;
+
+    while ( $elem ) {
+
+        my $parent = $elem->parent();
+
+        while ( $elem = $elem->sprevious_sibling() ) {
+            $elem->isa( 'PPI::Token::Word' )
+                and 'grep' eq $elem->content()
+                and return $TRUE;
+            $elem->isa( 'PPI::Token::Operator' )
+                and precedence_of( $elem ) >= $PRECEDENCE_OF_EQUALS
+                and return $FALSE;
+        }
+
+        $elem = $parent;
+    }
+
+    return $FALSE;
+
+}
+
+#-----------------------------------------------------------------------------
+
 sub _is_effectively_a_comma {
     my ($elem) = @_;
 
index 54062f9..7c983d0 100644 (file)
@@ -385,6 +385,20 @@ eval "something_else" && die;
 
 #-----------------------------------------------------------------------------
 
+## name A grep is a check -- RT #69489
+## failures 0
+## cut
+
+foreach ( grep { eval $_ } @bar ) { say }
+foreach ( grep { ! eval $_ } @bar ) { say }
+foreach ( grep eval $_, @bar ) { say }
+foreach ( grep ! eval $_, @bar ) { say }
+
+# grep $_, map eval $_, @foo;   # Should this be accepted?
+grep { $_ } map { eval $_ } @foo;   # Should this be rejected?
+
+#-----------------------------------------------------------------------------
+
 ##############################################################################
 #      $URL$
 #     $Date$