File Coverage

blib/lib/Perl/Lint/Policy/ValuesAndExpressions/ProhibitMismatchedOperators.pm
Criterion Covered Total %
statement 71 71 100.0
branch 33 38 86.8
condition 39 63 61.9
subroutine 7 7 100.0
pod 0 1 0.0
total 150 180 83.3


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::ValuesAndExpressions::ProhibitMismatchedOperators;
2 133     133   93322 use strict;
  133         256  
  133         4879  
3 133     133   582 use warnings;
  133         191  
  133         3238  
4 133     133   953 use Perl::Lint::Constants::Type;
  133         276  
  133         82826  
5 133     133   1465 use Perl::Lint::Constants::Kind;
  133         233  
  133         9257  
6 133     133   631 use parent "Perl::Lint::Policy";
  133         222  
  133         833  
7              
8             use constant {
9 133         87144 DESC => 'Mismatched operator',
10             EXPL => 'Numeric/string operators and operands should match',
11 133     133   8293 };
  133         221  
12              
13             sub evaluate {
14 6     6 0 16 my ($class, $file, $tokens, $args) = @_;
15              
16 6         75 my %numeric_ops = (
17             '==' => 1, '!=' => 1, '>' => 1,
18             '>=' => 1, '<' => 1, '<=' => 1,
19             '+' => 1, '-' => 1, '*' => 1,
20             '/' => 1, '+=' => 1, '-=' => 1,
21             '*=' => 1, '/=' => 1,
22             );
23              
24 6         48 my %string_ops = (
25             'eq' => 1, 'ne' => 1, 'lt' => 1,
26             'gt' => 1, 'le' => 1, 'ge' => 1,
27             '.' => 1, '.=' => 1,
28             );
29              
30 6         141 my %file_operators = (
31             '-r' => 1, '-w' => 1, '-x' => 1,
32             '-o' => 1, '-R' => 1, '-W' => 1,
33             '-X' => 1, '-O' => 1, '-e' => 1,
34             '-z' => 1, '-s' => 1, '-f' => 1,
35             '-d' => 1, '-l' => 1, '-p' => 1,
36             '-S' => 1, '-b' => 1, '-c' => 1,
37             '-t' => 1, '-u' => 1, '-g' => 1,
38             '-k' => 1, '-T' => 1, '-B' => 1,
39             '-M' => 1, '-A' => 1,
40             );
41              
42 6         10 my @violations;
43 6         41 for (my $i = 0, my $token_type, my $token_data, my $token_kind; my $token = $tokens->[$i]; $i++) {
44 606         762 $token_type = $token->{type};
45 606         690 $token_kind = $token->{kind};
46 606         774 $token_data = $token->{data};
47              
48 606 100 100     2832 if ($token_kind == KIND_OP || $token_kind == KIND_ASSIGN) {
    100          
49 168         176 my $is_in_numeric_context = 0;
50 168         166 my $is_in_string_context = 0;
51 168 100       418 if ($numeric_ops{$token_data}) {
    100          
52 62         71 $is_in_numeric_context = 1;
53             }
54             elsif ($string_ops{$token_data}) {
55 34         41 $is_in_string_context = 1;
56             }
57              
58 168 100 66     430 if (!$is_in_numeric_context && !$is_in_string_context) {
59             # Not target operator
60 72         194 next;
61             }
62              
63 96         142 my $before_token = $tokens->[$i-1];
64 96         126 my $next_token = $tokens->[$i+1];
65              
66 96         126 my $before_token_type = $before_token->{type};
67 96         122 my $next_token_type = $next_token->{type};
68              
69 96         107 my $is_before_token_variable = 0;
70 96 50 66     677 if (
      66        
      66        
      66        
      66        
71             # XXX enough?
72             $before_token_type == VAR ||
73             $before_token_type == ARRAY_VAR ||
74             $before_token_type == HASH_VAR ||
75             $before_token_type == GLOBAL_VAR ||
76             $before_token_type == GLOBAL_ARRAY_VAR ||
77             $before_token_type == GLOBAL_HASH_VAR
78             ) {
79 50         54 $is_before_token_variable = 1;
80             }
81              
82 96         96 my $is_next_token_variable = 0;
83 96 50 66     1021 if (
      66        
      33        
      33        
      33        
84             # XXX enough?
85             $next_token_type == VAR ||
86             $next_token_type == ARRAY_VAR ||
87             $next_token_type == HASH_VAR ||
88             $next_token_type == GLOBAL_VAR ||
89             $next_token_type == GLOBAL_ARRAY_VAR ||
90             $next_token_type == GLOBAL_HASH_VAR
91             ) {
92 21         23 $is_next_token_variable = 1;
93             }
94              
95 96 100 100     280 if ($is_before_token_variable && $is_next_token_variable) {
96             # when both of lvalue and rvalue are variable
97             # e.g
98             # $foo > $bar
99 14         15 $i++;
100 14         41 next;
101             }
102              
103 82         79 my $is_before_token_numeric = 0;
104 82 100 66     293 if ($before_token_type == INT || $before_token_type == DOUBLE) {
105 14         16 $is_before_token_numeric = 1;
106 14 100       39 if ($tokens->[$i-2]->{type} == STRING_MUL) {
107 4         6 $is_before_token_numeric = 0;
108             }
109             }
110              
111 82         119 my $is_next_token_numeric = 0;
112 82 100 66     238 if ($next_token_type == INT || $next_token_type == DOUBLE) {
113 49         49 $is_next_token_numeric = 1;
114             }
115              
116 82 100       153 if ($is_in_numeric_context) {
    50          
117 48 50 66     266 if (
      66        
      66        
118             (!$is_before_token_numeric && !$is_before_token_variable) ||
119             (!$is_next_token_numeric && !$is_next_token_variable)
120             ) {
121 24         171 push @violations, {
122             filename => $file,
123             line => $token->{line},
124             description => DESC,
125             explanation => EXPL,
126             policy => __PACKAGE__,
127             };
128             }
129             }
130             elsif ($is_in_string_context) {
131 34 100 33     229 if (
      66        
      33        
132             ($is_before_token_numeric && !$is_before_token_variable) ||
133             ($is_next_token_numeric && !$is_next_token_variable)
134             ) {
135 15         128 push @violations, {
136             filename => $file,
137             line => $token->{line},
138             description => DESC,
139             explanation => EXPL,
140             policy => __PACKAGE__,
141             };
142             }
143             }
144             }
145             elsif ($token_type == HANDLE) {
146 59 50       119 if ($file_operators{$token_data}) {
147 59         124 for ($i++; $token = $tokens->[$i]; $i++) {
148 119         139 $token_type = $token->{type};
149 119         134 $token_kind = $token->{kind};
150 119 100       298 if ($token_kind == KIND_OP) {
    100          
151 55 100       120 if ($string_ops{$token->{data}}) {
152 30         123 push @violations, {
153             filename => $file,
154             line => $token->{line},
155             description => DESC,
156             explanation => EXPL,
157             policy => __PACKAGE__,
158             };
159             }
160 55         149 last;
161             }
162             elsif ($token_type == SEMI_COLON) {
163 4         13 last; # fail safe
164             }
165             }
166             }
167             }
168             }
169              
170 6         94 return \@violations;
171             }
172              
173             1;
174