| Subject: | ValuesAndExpressions::ProhibitMismatchedOperators: false positive for file operators |
Raised on behalf of hmbrand:
---
This policy erroneously reports mismatches for -M operator:
[ValuesAndExpressions::ProhibitMismatchedOperators] Mismatched operator
at line 58, near '-M "prolep.ML" < 0 && -M "prolep.MV" < 0 or die
"Omzetting mislukt\n";'. (Severity: 3)
The policy reports:
-M "foo.txt" < 0;
It does not report:
my $foo = "foo.txt";
-M $foo < 0
---
I have attached a patch to ProhibitMismatchedOperators and updated
the tests accordingly.
All file operators in perlfunc are supported (-r -w -x -o -R -W -X -O -e
-z -s -f -d
-l -p -S -b -c -t -u -g -k -T -B -M -A).
Please have a look and comment.
| Subject: | ProhibitMismatchedOperators.pm.patch |
--- lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.pm (revision 3852)
+++ lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.pm (working copy)
@@ -38,6 +38,10 @@
'PPI::Token::Quote' => [ 0, 1 ],
);
+# file operators
+
+Readonly::Hash my %FILE_OPS => (map { ("-$_") => [ 1, 0 ] } qw( r w x o R W X O e z s f d l p S b c t u g k T B M A ));
+
#-----------------------------------------------------------------------------
sub supported_parameters { return () }
@@ -54,7 +58,7 @@
return if !exists $OP_TYPES{$elem_text};
- my $prev_elem = $elem->sprevious_sibling();
+ my $prev_elem = $self->_get_prev_elem($elem);
return if not $prev_elem;
my $next_elem = $elem->snext_sibling();
@@ -77,7 +81,7 @@
return if $op_type && defined $prev_compat &&
! $prev_compat->[$op_type] &&
$self->_have_stringy_x( $prev_elem ); # RT 54524
-
+
return $self->violation( $DESC, $EXPL, $elem );
}
@@ -87,6 +91,7 @@
sub _get_token_compat {
my ( $self, $elem ) = @_;
+ return $FILE_OPS{$elem->content()} if $self->_is_file_op( $elem );
for my $class ( keys %TOKEN_COMPAT ) {
return $TOKEN_COMPAT{$class} if $elem->isa($class);
}
@@ -108,6 +113,35 @@
return $TRUE;
}
+#-----------------------------------------------------------------------------
+
+# get previous element
+
+sub _get_prev_elem {
+ my ($self, $elem) = @_;
+ my $prev_elem = $elem->sprevious_sibling() or return;
+ if ( $self->_get_token_compat( $prev_elem ) ) {
+ my $prev_sibling = $prev_elem->sprevious_sibling();
+ if ( $prev_sibling && $self->_is_file_op( $prev_sibling ) ) {
+ $prev_elem = $prev_sibling
+ }
+ }
+ return $prev_elem;
+}
+
+#-----------------------------------------------------------------------------
+
+# is file operator
+
+sub _is_file_op {
+ my ($self, $elem ) = @_;
+ $elem or return;
+ $elem->isa('PPI::Token::Operator')
+ and $FILE_OPS{$elem->content()}
+ or return;
+ return $TRUE;
+}
+
1;
__END__
@@ -149,7 +183,7 @@
If L<warnings|warnings> are enabled, the Perl interpreter usually
warns you about using mismatched operators at run-time. This Policy
does essentially the same thing, but at author-time. That way, you
-can find our about them sooner.
+can find out about them sooner.
=head1 AUTHOR
| Subject: | ProhibitMismatchedOperators.run.patch |
--- t/ValuesAndExpressions/ProhibitMismatchedOperators.run (revision 3852)
+++ t/ValuesAndExpressions/ProhibitMismatchedOperators.run (working copy)
@@ -55,6 +55,67 @@
#-----------------------------------------------------------------------------
+## name File operators passing
+## failures 0
+## cut
+
+-M 'file' > 0;
+-r 'file' < 1;
+-w 'file' != 1;
+-x 'file' == 0;
+-o 'file' == 1234;
+-R 'file' != 3210;
+-W 'file' == 4321;
+-X 'file' != 5678;
+-O 'file' == 9876l;
+-e 'file' == 1 && -z 'file';
+-s 'file' / 1024;
+-f 'file' == 1 && -d 'file' != 1;
+-l 'file' && !-p 'file';
+-S 'file' == 1 && -b 'file' != 1;
+-c 'file' + 1;
+-t 'file' > 1;
+-u 'file' * 123;
+-g 'file' != 1;
+-k 'file' - -T 'file';
+-B 'file' < 1;
+-M 'file' + -A 'file';
+(-M 'file') > 0 || -M 'file' > 0;
+
+#-----------------------------------------------------------------------------
+
+## name File operators failure
+## failures 25
+## cut
+
+-M 'file' gt "0";
+-r 'file' lt "1";
+-w 'file' ne "1";
+-x 'file' eq "0";
+-o 'file' eq "1234";
+-R 'file' ne "3210";
+-W 'file' eq "4321";
+-X 'file' ne "5678";
+-O 'file' eq "9876l";
+-e 'file' eq "1";
+-z 'file' ne "1";
+-s 'file' eq "1024";
+-f 'file' eq "1";
+-d 'file' ne "1";
+-l 'file' eq "1";
+-S 'file' eq "1";
+-b 'file' ne "1";
+-c 'file' eq "1";
+-t 'file' gt "1";
+-u 'file' eq "123";
+-g 'file' ne "1";
+-k 'file' eq "1";
+-T 'file' ne "1";
+-B 'file' lt "1";
+-A 'file' eq "1";
+
+#-----------------------------------------------------------------------------
+
##############################################################################
# $URL$
# $Date$