File Coverage

blib/lib/Perl/Critic/Policy/ControlStructures/ProhibitNegativeExpressionsInUnlessAndUntilConditions.pm
Criterion Covered Total %
statement 52 58 89.6
branch 15 24 62.5
condition 5 6 83.3
subroutine 14 15 93.3
pod 4 5 80.0
total 90 108 83.3


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions;
2              
3 40     40   25297 use 5.010001;
  40         149  
4 40     40   185 use strict;
  40         80  
  40         999  
5 40     40   146 use warnings;
  40         83  
  40         1490  
6 40     40   160 use Readonly;
  40         85  
  40         2362  
7              
8 40     40   211 use Perl::Critic::Utils qw< :characters :severities :classification hashify >;
  40         71  
  40         2122  
9              
10 40     40   17150 use parent 'Perl::Critic::Policy';
  40         92  
  40         273  
11              
12             our $VERSION = '1.156';
13              
14             #-----------------------------------------------------------------------------
15              
16             Readonly::Scalar my $EXPL => [99];
17              
18             #-----------------------------------------------------------------------------
19              
20 90     90 0 789 sub supported_parameters { return qw< > }
21 75     75 1 225 sub default_severity { return $SEVERITY_MEDIUM }
22 86     86 1 274 sub default_themes { return qw( core maintenance pbp ) }
23 31     31 1 80 sub applies_to { return 'PPI::Token::Word' }
24              
25             #-----------------------------------------------------------------------------
26              
27             sub violates {
28 332     332 1 499 my ( $self, $token, undef ) = @_;
29              
30 332         429 state $until_or_unless = { hashify( qw( until unless ) ) };
31 332 100       551 return if !exists $until_or_unless->{$token->content};
32              
33 18 50       70 return if is_hash_key($token);
34 18 50       48 return if is_subroutine_name($token);
35 18 50       420 return if is_method_call($token);
36 18 50       110 return if is_included_module_name($token);
37              
38             return
39             map
40 18         50 { $self->_violation_for_operator( $_, $token ) }
  0         0  
41             _get_negative_operators( $token );
42             }
43              
44             #-----------------------------------------------------------------------------
45              
46             sub _get_negative_operators {
47 18     18   30 my ($token) = @_;
48              
49 18         26 my @operators;
50 18         29 foreach my $element ( _get_condition_elements($token) ) {
51 48 100       280 if ( $element->isa('PPI::Node') ) {
52 2         23 my $operators = $element->find( \&_is_negative_operator );
53 2 50       24 if ($operators) {
54 0         0 push @operators, @{$operators};
  0         0  
55             }
56             }
57             else {
58 46 50       67 if ( _is_negative_operator( undef, $element ) ) {
59 0         0 push @operators, $element;
60             }
61             }
62             }
63              
64 18         53 return @operators;
65             }
66              
67             #-----------------------------------------------------------------------------
68              
69             sub _get_condition_elements {
70 18     18   31 my ($token) = @_;
71              
72 18         31 my $statement = $token->statement();
73 18 50       154 return if not $statement;
74              
75 18 100       64 if ($statement->isa('PPI::Statement::Compound')) {
76 2         6 my $condition = $token->snext_sibling();
77              
78 2 50       64 return if not $condition;
79 2 50       14 return if not $condition->isa('PPI::Structure::Condition');
80              
81 2         8 return ( $condition );
82             }
83              
84 16         20 my @condition_elements;
85 16         22 my $element = $token;
86 16   100     30 while (
87             $element = $element->snext_sibling()
88             and $element->content() ne $SCOLON
89             ) {
90 46         915 push @condition_elements, $element;
91             }
92              
93 16         276 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 64     64   276 my (undef, $element) = @_;
109              
110             return
111             $element->isa('PPI::Token::Operator')
112 64   66     215 && $NEGATIVE_OPERATORS{$element};
113             }
114              
115             #-----------------------------------------------------------------------------
116              
117             sub _violation_for_operator {
118 0     0     my ($self, $operator, $control_structure) = @_;
119              
120             return
121 0           $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-2023 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 :