File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.pm
Criterion Covered Total %
statement 63 63 100.0
branch 35 42 83.3
condition 33 38 86.8
subroutine 16 16 100.0
pod 4 5 80.0
total 151 164 92.0


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators;
2 40     40   28073 use 5.010001;
  40         166  
3 40     40   259 use strict;
  40         97  
  40         926  
4 40     40   201 use warnings;
  40         125  
  40         942  
5 40     40   307 use Readonly;
  40         107  
  40         2148  
6              
7 40     40   265 use Perl::Critic::Utils qw{ :booleans :severities hashify };
  40         113  
  40         2403  
8 40     40   6798 use parent 'Perl::Critic::Policy';
  40         106  
  40         227  
9              
10             our $VERSION = '1.148';
11              
12             #-----------------------------------------------------------------------------
13              
14             Readonly::Scalar my $DESC => q<Mismatched operator>;
15             Readonly::Scalar my $EXPL => q<Numeric/string operators and operands should match>;
16              
17             # token compatibility [ numeric, string ]
18             Readonly::Hash my %TOKEN_COMPATIBILITY => (
19             'PPI::Token::Number' => [$TRUE, $FALSE],
20             'PPI::Token::Symbol' => [$TRUE, $TRUE ],
21             'PPI::Token::Quote' => [$FALSE, $TRUE ],
22             );
23              
24             Readonly::Hash my %FILE_OPERATOR_COMPATIBILITY =>
25             map {; "-$_" => [$TRUE, $FALSE] }
26             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 >;
27              
28             Readonly::Scalar my $TOKEN_COMPATIBILITY_INDEX_NUMERIC => 0;
29             Readonly::Scalar my $TOKEN_COMPATIBILITY_INDEX_STRING => 1;
30              
31             Readonly::Hash my %OPERATOR_TYPES => (
32             # numeric
33             (
34             map { $_ => $TOKEN_COMPATIBILITY_INDEX_NUMERIC }
35             qw[ == != > >= < <= + - * / += -= *= /= ]
36             ),
37             # string
38             map { $_ => $TOKEN_COMPATIBILITY_INDEX_STRING }
39             qw< eq ne lt gt le ge . .= >,
40             );
41              
42             Readonly::Scalar my $TOKEN_COMPATIBILITY_SPECIAL_STRING_OPERATOR => qw{+};
43             Readonly::Hash my %SPECIAL_STRING_VALUES =>
44             hashify( qw('nan' 'inf' '-inf' '+inf') );
45              
46             #-----------------------------------------------------------------------------
47              
48 96     96 0 1741 sub supported_parameters { return () }
49 140     140 1 564 sub default_severity { return $SEVERITY_MEDIUM }
50 74     74 1 376 sub default_themes { return qw< core bugs certrule > }
51 37     37 1 156 sub applies_to { return 'PPI::Token::Operator' }
52              
53             #-----------------------------------------------------------------------------
54              
55             sub violates {
56 425     425 1 943 my ($self, $elem) = @_;
57              
58 425         1071 my $elem_text = $elem->content();
59              
60 425 100       2296 return if not exists $OPERATOR_TYPES{$elem_text};
61              
62 170 50       1302 my $leading_operator = $self->_get_potential_leading_operator($elem)
63             or return;
64              
65 170 50       480 my $next_elem = $elem->snext_sibling() or return;
66              
67 170 100       6479 if ( $next_elem->isa('PPI::Token::Operator') ) {
68 2         9 $elem_text .= $next_elem->content();
69 2         13 $next_elem = $next_elem->snext_sibling();
70             }
71              
72 170 100       710 return if not exists $OPERATOR_TYPES{$elem_text};
73 168         1448 my $operator_type = $OPERATOR_TYPES{$elem_text};
74              
75 168         1244 my $leading_operator_compatibility =
76             $self->_get_token_compatibility($leading_operator);
77 168         1752 my $next_compatibility = $self->_get_token_compatibility($next_elem);
78              
79             return if
80             (
81 168 100 100     1657 ! defined $leading_operator_compatibility
      66        
      100        
82             || $leading_operator_compatibility->[$operator_type]
83             )
84             && (
85             ! defined $next_compatibility
86             || $next_compatibility->[$operator_type]
87             );
88              
89             return if
90 76 100 66     1020 $operator_type
      100        
      100        
91             && defined $leading_operator_compatibility
92             && ! $leading_operator_compatibility->[$operator_type]
93             && $self->_have_stringy_x($leading_operator); # RT 54524
94              
95 72 100       785 return if $self->_is_special_string_number_addion($elem_text, $leading_operator, $next_elem);
96              
97 66         226 return $self->violation($DESC, $EXPL, $elem);
98             }
99              
100             #-----------------------------------------------------------------------------
101              
102             sub _get_token_compatibility {
103 506     506   1107 my ($self, $elem) = @_;
104              
105 506 100       1003 return $FILE_OPERATOR_COMPATIBILITY{ $elem->content() }
106             if $self->_is_file_operator($elem);
107              
108 460         1377 for my $class (keys %TOKEN_COMPATIBILITY) {
109 887 100       9252 return $TOKEN_COMPATIBILITY{$class} if $elem->isa($class);
110             }
111              
112 2         17 return;
113             }
114              
115             #-----------------------------------------------------------------------------
116              
117             sub _have_stringy_x {
118 29     29   249 my ($self, $elem) = @_;
119              
120 29 50       99 return if not $elem;
121              
122 29 100       86 my $prev_oper = $elem->sprevious_sibling() or return;
123              
124 4 50       125 return if not $prev_oper->isa('PPI::Token::Operator');
125 4 50       13 return if 'x' ne $prev_oper->content();
126              
127 4         27 return !! $prev_oper->sprevious_sibling();
128             }
129              
130             #-----------------------------------------------------------------------------
131              
132             sub _get_potential_leading_operator {
133 170     170   392 my ($self, $elem) = @_;
134              
135 170 50       439 my $previous_element = $elem->sprevious_sibling() or return;
136              
137 170 100       6659 if ( $self->_get_token_compatibility($previous_element) ) {
138 169         1480 my $previous_sibling = $previous_element->sprevious_sibling();
139 169 100 100     5552 if (
140             $previous_sibling and $self->_is_file_operator($previous_sibling)
141             ) {
142 48         626 $previous_element = $previous_sibling;
143             }
144             }
145              
146 170         1472 return $previous_element;
147             }
148              
149             #-----------------------------------------------------------------------------
150              
151             sub _is_file_operator {
152 645     645   1192 my ($self, $elem) = @_;
153              
154 645 50       1747 return if not $elem;
155 645 100       2478 return if not $elem->isa('PPI::Token::Operator');
156 170         442 return !! $FILE_OPERATOR_COMPATIBILITY{ $elem->content() }
157             }
158              
159             #-----------------------------------------------------------------------------
160              
161             sub _is_special_string_number_addion {
162 140     140   327 my ($self, $elem_operator, $element_1, $element_2, $check_recursive) = @_;
163              
164             return 1 if $elem_operator
165             && $elem_operator eq $TOKEN_COMPATIBILITY_SPECIAL_STRING_OPERATOR
166 140 100 66     520 && $SPECIAL_STRING_VALUES{lc($element_1->content()//0)}
      50        
      100        
      66        
      100        
167             && $element_2->isa('PPI::Token::Number')
168             && $element_2->content() == 0;
169 134 100 100     497 return 1 if !$check_recursive && $self->_is_special_string_number_addion($elem_operator, $element_2, $element_1, 1);
170              
171 132         370 return;
172             }
173              
174             1;
175              
176             __END__
177              
178             #-----------------------------------------------------------------------------
179              
180             =pod
181              
182             =head1 NAME
183              
184             Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators - Don't mix numeric operators with string operands, or vice-versa.
185              
186              
187             =head1 AFFILIATION
188              
189             This Policy is part of the core L<Perl::Critic|Perl::Critic>
190             distribution.
191              
192              
193             =head1 DESCRIPTION
194              
195             Using the wrong operator type for a value can obscure coding intent
196             and possibly lead to subtle errors. An example of this is mixing a
197             string equality operator with a numeric value, or vice-versa.
198              
199             if ($foo == 'bar') {} #not ok
200             if ($foo eq 'bar') {} #ok
201             if ($foo eq 123) {} #not ok
202             if ($foo == 123) {} #ok
203              
204              
205             =head1 CONFIGURATION
206              
207             This Policy is not configurable except for the standard options.
208              
209             =for stopwords NaN struct
210              
211             =head1 NOTES
212              
213             If L<warnings|warnings> are enabled, the Perl interpreter usually
214             warns you about using mismatched operators at run-time. This Policy
215             does essentially the same thing, but at author-time. That way, you
216             can find out about them sooner.
217              
218             Perl handles the strings 'NaN' and 'inf' as special numbers and creates an NV struct when compared with a numeric operator.
219             Although not necessary it is allowed to write code such as:
220             my $i = 'inf'+0;
221             This pattern helps others understand that the variable is indeed the Infinite or NaN numbers as Perl interprets them.
222             Only these two special string numbers are allowed to have the '+' operator which would otherwise be allowed only for strings.
223              
224              
225             =head1 AUTHOR
226              
227             Peter Guzis <pguzis@cpan.org>
228              
229              
230             =head1 COPYRIGHT
231              
232             Copyright (c) 2006-2022 Peter Guzis. All rights reserved.
233              
234             This program is free software; you can redistribute it and/or modify
235             it under the same terms as Perl itself. The full text of this license
236             can be found in the LICENSE file included with this module.
237              
238             =cut
239              
240             # Local Variables:
241             # mode: cperl
242             # cperl-indent-level: 4
243             # fill-column: 78
244             # indent-tabs-mode: nil
245             # c-indentation-style: bsd
246             # End:
247             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :