line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions; |
2
|
|
|
|
|
|
|
|
3
|
40
|
|
|
40
|
|
27665
|
use 5.010001; |
|
40
|
|
|
|
|
192
|
|
4
|
40
|
|
|
40
|
|
278
|
use strict; |
|
40
|
|
|
|
|
136
|
|
|
40
|
|
|
|
|
874
|
|
5
|
40
|
|
|
40
|
|
231
|
use warnings; |
|
40
|
|
|
|
|
127
|
|
|
40
|
|
|
|
|
1352
|
|
6
|
40
|
|
|
40
|
|
286
|
use English qw(-no_match_vars); |
|
40
|
|
|
|
|
135
|
|
|
40
|
|
|
|
|
446
|
|
7
|
40
|
|
|
40
|
|
16946
|
use Readonly; |
|
40
|
|
|
|
|
123
|
|
|
40
|
|
|
|
|
2106
|
|
8
|
|
|
|
|
|
|
|
9
|
40
|
|
|
40
|
|
345
|
use Perl::Critic::Utils qw< :characters :severities :classification hashify >; |
|
40
|
|
|
|
|
126
|
|
|
40
|
|
|
|
|
2235
|
|
10
|
|
|
|
|
|
|
|
11
|
40
|
|
|
40
|
|
20910
|
use parent 'Perl::Critic::Policy'; |
|
40
|
|
|
|
|
131
|
|
|
40
|
|
|
|
|
311
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '1.148'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
Readonly::Scalar my $EXPL => [99]; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
20
|
|
|
|
|
|
|
|
21
|
149
|
|
|
149
|
0
|
2083
|
sub supported_parameters { return qw< > } |
22
|
134
|
|
|
134
|
1
|
623
|
sub default_severity { return $SEVERITY_MEDIUM } |
23
|
86
|
|
|
86
|
1
|
446
|
sub default_themes { return qw( core maintenance pbp ) } |
24
|
90
|
|
|
90
|
1
|
314
|
sub applies_to { return 'PPI::Token::Word' } |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub violates { |
29
|
824
|
|
|
824
|
1
|
1699
|
my ( $self, $token, undef ) = @_; |
30
|
|
|
|
|
|
|
|
31
|
824
|
100
|
100
|
|
|
1787
|
return if $token->content() ne 'until' && $token->content() ne 'unless'; |
32
|
|
|
|
|
|
|
|
33
|
78
|
50
|
|
|
|
736
|
return if is_hash_key($token); |
34
|
78
|
50
|
|
|
|
257
|
return if is_subroutine_name($token); |
35
|
78
|
50
|
|
|
|
264
|
return if is_method_call($token); |
36
|
78
|
50
|
|
|
|
617
|
return if is_included_module_name($token); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
return |
39
|
|
|
|
|
|
|
map |
40
|
78
|
|
|
|
|
270
|
{ $self->_violation_for_operator( $_, $token ) } |
|
60
|
|
|
|
|
186
|
|
41
|
|
|
|
|
|
|
_get_negative_operators( $token ); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub _get_negative_operators { |
47
|
78
|
|
|
78
|
|
189
|
my ($token) = @_; |
48
|
|
|
|
|
|
|
|
49
|
78
|
|
|
|
|
167
|
my @operators; |
50
|
78
|
|
|
|
|
251
|
foreach my $element ( _get_condition_elements($token) ) { |
51
|
164
|
100
|
|
|
|
811
|
if ( $element->isa('PPI::Node') ) { |
52
|
32
|
|
|
|
|
149
|
my $operators = $element->find( \&_is_negative_operator ); |
53
|
32
|
100
|
|
|
|
486
|
if ($operators) { |
54
|
30
|
|
|
|
|
58
|
push @operators, @{$operators}; |
|
30
|
|
|
|
|
103
|
|
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
else { |
58
|
132
|
100
|
|
|
|
315
|
if ( _is_negative_operator( undef, $element ) ) { |
59
|
30
|
|
|
|
|
524
|
push @operators, $element; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
78
|
|
|
|
|
260
|
return @operators; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub _get_condition_elements { |
70
|
78
|
|
|
78
|
|
184
|
my ($token) = @_; |
71
|
|
|
|
|
|
|
|
72
|
78
|
|
|
|
|
220
|
my $statement = $token->statement(); |
73
|
78
|
50
|
|
|
|
1131
|
return if not $statement; |
74
|
|
|
|
|
|
|
|
75
|
78
|
100
|
|
|
|
322
|
if ($statement->isa('PPI::Statement::Compound')) { |
76
|
32
|
|
|
|
|
110
|
my $condition = $token->snext_sibling(); |
77
|
|
|
|
|
|
|
|
78
|
32
|
50
|
|
|
|
713
|
return if not $condition; |
79
|
32
|
50
|
|
|
|
156
|
return if not $condition->isa('PPI::Structure::Condition'); |
80
|
|
|
|
|
|
|
|
81
|
32
|
|
|
|
|
114
|
return ( $condition ); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
46
|
|
|
|
|
148
|
my @condition_elements; |
85
|
46
|
|
|
|
|
109
|
my $element = $token; |
86
|
46
|
|
100
|
|
|
158
|
while ( |
87
|
|
|
|
|
|
|
$element = $element->snext_sibling() |
88
|
|
|
|
|
|
|
and $element->content() ne $SCOLON |
89
|
|
|
|
|
|
|
) { |
90
|
132
|
|
|
|
|
4184
|
push @condition_elements, $element; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
46
|
|
|
|
|
1575
|
return @condition_elements; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Readonly::Hash my %NEGATIVE_OPERATORS => hashify( |
99
|
|
|
|
|
|
|
qw/ |
100
|
|
|
|
|
|
|
! not |
101
|
|
|
|
|
|
|
!~ ne != |
102
|
|
|
|
|
|
|
< > <= >= <=> |
103
|
|
|
|
|
|
|
lt gt le ge cmp |
104
|
|
|
|
|
|
|
/ |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub _is_negative_operator { |
108
|
322
|
|
|
322
|
|
3058
|
my (undef, $element) = @_; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
return |
111
|
|
|
|
|
|
|
$element->isa('PPI::Token::Operator') |
112
|
322
|
|
66
|
|
|
1646
|
&& $NEGATIVE_OPERATORS{$element}; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub _violation_for_operator { |
118
|
60
|
|
|
60
|
|
153
|
my ($self, $operator, $control_structure) = @_; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
return |
121
|
60
|
|
|
|
|
209
|
$self->violation( |
122
|
|
|
|
|
|
|
qq<Found "$operator" in condition for an "$control_structure">, |
123
|
|
|
|
|
|
|
$EXPL, |
124
|
|
|
|
|
|
|
$control_structure, |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
1; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
__END__ |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=pod |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=for stopwords |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head1 NAME |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions - Don't use operators like C<not>, C<!~>, and C<le> within C<until> and C<unless>. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head1 AFFILIATION |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
This Policy is part of the core L<Perl::Critic|Perl::Critic> |
145
|
|
|
|
|
|
|
distribution. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 DESCRIPTION |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
until ($foo ne 'blah') { #not ok |
151
|
|
|
|
|
|
|
... |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
while ($foo eq 'blah') { #ok |
155
|
|
|
|
|
|
|
... |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
A number of people have problems figuring out the meaning of doubly |
159
|
|
|
|
|
|
|
negated expressions. C<unless> and C<until> are both negative |
160
|
|
|
|
|
|
|
constructs, so any negative (e.g. C<!~>) or reversible operators (e.g. |
161
|
|
|
|
|
|
|
C<le>) included in their conditional expressions are double negations. |
162
|
|
|
|
|
|
|
Conway considers the following operators to be difficult to understand |
163
|
|
|
|
|
|
|
within C<unless> and C<until>: |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
! not |
166
|
|
|
|
|
|
|
!~ ne != |
167
|
|
|
|
|
|
|
< > <= >= <=> |
168
|
|
|
|
|
|
|
lt gt le ge cmp |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head1 CONFIGURATION |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
This Policy is not configurable except for the standard options. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head1 SEE ALSO |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
L<Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks|Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks> |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head1 AUTHOR |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Elliot Shank C<< <perl@galumph.com> >> |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head1 COPYRIGHT |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
Copyright (c) 2007-2011 Elliot Shank. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
190
|
|
|
|
|
|
|
it under the same terms as Perl itself. The full text of this license |
191
|
|
|
|
|
|
|
can be found in the LICENSE file included with this module. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=cut |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# Local Variables: |
196
|
|
|
|
|
|
|
# mode: cperl |
197
|
|
|
|
|
|
|
# cperl-indent-level: 4 |
198
|
|
|
|
|
|
|
# fill-column: 78 |
199
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
200
|
|
|
|
|
|
|
# c-indentation-style: bsd |
201
|
|
|
|
|
|
|
# End: |
202
|
|
|
|
|
|
|
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : |