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   69231 use strict;
  133         166  
  133         3278  
3 133     133   392 use warnings;
  133         153  
  133         2440  
4 133     133   776 use Perl::Lint::Constants::Type;
  133         148  
  133         60214  
5 133     133   878 use Perl::Lint::Constants::Kind;
  133         173  
  133         6836  
6 133     133   475 use parent "Perl::Lint::Policy";
  133         147  
  133         523  
7              
8             use constant {
9 133         61541 DESC => 'Mismatched operator',
10             EXPL => 'Numeric/string operators and operands should match',
11 133     133   6364 };
  133         155  
12              
13             sub evaluate {
14 6     6 0 8 my ($class, $file, $tokens, $args) = @_;
15              
16 6         41 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         29 my %string_ops = (
25             'eq' => 1, 'ne' => 1, 'lt' => 1,
26             'gt' => 1, 'le' => 1, 'ge' => 1,
27             '.' => 1, '.=' => 1,
28             );
29              
30 6         47 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         7 my @violations;
43 6         20 for (my $i = 0, my $token_type, my $token_data, my $token_kind; my $token = $tokens->[$i]; $i++) {
44 606         388 $token_type = $token->{type};
45 606         377 $token_kind = $token->{kind};
46 606         389 $token_data = $token->{data};
47              
48 606 100 100     1671 if ($token_kind == KIND_OP || $token_kind == KIND_ASSIGN) {
    100          
49 168         92 my $is_in_numeric_context = 0;
50 168         96 my $is_in_string_context = 0;
51 168 100       215 if ($numeric_ops{$token_data}) {
    100          
52 62         49 $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     249 if (!$is_in_numeric_context && !$is_in_string_context) {
59             # Not target operator
60 72         106 next;
61             }
62              
63 96         74 my $before_token = $tokens->[$i-1];
64 96         66 my $next_token = $tokens->[$i+1];
65              
66 96         71 my $before_token_type = $before_token->{type};
67 96         65 my $next_token_type = $next_token->{type};
68              
69 96         51 my $is_before_token_variable = 0;
70 96 50 66     417 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         35 $is_before_token_variable = 1;
80             }
81              
82 96         61 my $is_next_token_variable = 0;
83 96 50 66     553 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         18 $is_next_token_variable = 1;
93             }
94              
95 96 100 100     181 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         8 $i++;
100 14         23 next;
101             }
102              
103 82         47 my $is_before_token_numeric = 0;
104 82 100 66     179 if ($before_token_type == INT || $before_token_type == DOUBLE) {
105 14         10 $is_before_token_numeric = 1;
106 14 100       21 if ($tokens->[$i-2]->{type} == STRING_MUL) {
107 4         2 $is_before_token_numeric = 0;
108             }
109             }
110              
111 82         56 my $is_next_token_numeric = 0;
112 82 100 66     140 if ($next_token_type == INT || $next_token_type == DOUBLE) {
113 49         32 $is_next_token_numeric = 1;
114             }
115              
116 82 100       93 if ($is_in_numeric_context) {
    50          
117 48 50 66     158 if (
      66        
      66        
118             (!$is_before_token_numeric && !$is_before_token_variable) ||
119             (!$is_next_token_numeric && !$is_next_token_variable)
120             ) {
121             push @violations, {
122             filename => $file,
123             line => $token->{line},
124 24         80 description => DESC,
125             explanation => EXPL,
126             policy => __PACKAGE__,
127             };
128             }
129             }
130             elsif ($is_in_string_context) {
131 34 100 33     137 if (
      66        
      33        
132             ($is_before_token_numeric && !$is_before_token_variable) ||
133             ($is_next_token_numeric && !$is_next_token_variable)
134             ) {
135             push @violations, {
136             filename => $file,
137             line => $token->{line},
138 15         55 description => DESC,
139             explanation => EXPL,
140             policy => __PACKAGE__,
141             };
142             }
143             }
144             }
145             elsif ($token_type == HANDLE) {
146 59 50       72 if ($file_operators{$token_data}) {
147 59         86 for ($i++; $token = $tokens->[$i]; $i++) {
148 119         86 $token_type = $token->{type};
149 119         73 $token_kind = $token->{kind};
150 119 100       190 if ($token_kind == KIND_OP) {
    100          
151 55 100       79 if ($string_ops{$token->{data}}) {
152             push @violations, {
153             filename => $file,
154             line => $token->{line},
155 30         58 description => DESC,
156             explanation => EXPL,
157             policy => __PACKAGE__,
158             };
159             }
160 55         84 last;
161             }
162             elsif ($token_type == SEMI_COLON) {
163 4         8 last; # fail safe
164             }
165             }
166             }
167             }
168             }
169              
170 6         41 return \@violations;
171             }
172              
173             1;
174