File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/ConstantBeforeLt.pm
Criterion Covered Total %
statement 94 94 100.0
branch 45 50 90.0
condition 9 11 81.8
subroutine 15 15 100.0
pod 1 1 100.0
total 164 171 95.9


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Kevin Ryde
2              
3             # This file is part of Perl-Critic-Pulp.
4              
5             # Perl-Critic-Pulp is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU General Public License as published
7             # by the Free Software Foundation; either version 3, or (at your option) any
8             # later version.
9             #
10             # Perl-Critic-Pulp is distributed in the hope that it will be
11             # useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
13             # Public License for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Perl-Critic-Pulp. If not, see
17             # <http://www.gnu.org/licenses/>.
18              
19              
20             package Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt;
21 40     40   33455 use 5.006;
  40         1351  
22 40     40   231 use strict;
  40         1223  
  40         889  
23 40     40   204 use warnings;
  40         179  
  40         1206  
24 40     40   18422 use PPI 1.220; # for its incompatible change to PPI::Statement::Sub->prototype
  40         1503090  
  40         1581  
25 40     40   365 use base 'Perl::Critic::Policy';
  40         100  
  40         6345  
26 40         3665 use Perl::Critic::Utils qw(is_included_module_name
27             is_method_call
28             is_perl_builtin_with_no_arguments
29 40     40   112752 split_nodes_on_comma);
  40         101  
30              
31             # uncomment this to run the ### lines
32             # use Smart::Comments;
33              
34             our $VERSION = 98;
35              
36             #
37             # Incidentally "require Foo < 123" is a similar sort of problem in all Perls
38             # (or at least up to 5.10.0) with "<" being taken to be a "< >". But since
39             # it always provokes a warning when run it doesn't really need perlcritic,
40             # or if it does then leave it to another policy to address.
41             #
42              
43 40     40   292 use constant supported_parameters => ();
  40         99  
  40         2901  
44 40     40   338 use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM;
  40         107  
  40         2236  
45 40     40   277 use constant default_themes => qw(pulp bugs);
  40         98  
  40         2289  
46 40     40   243 use constant applies_to => ('PPI::Document');
  40         103  
  40         28941  
47              
48             sub violates {
49 14     14 1 575993 my ($self, $document) = @_;
50              
51 14         31 my @violations;
52             my %constants;
53 14         25 my $constants = \%constants;
54             $document->find
55             (sub {
56 246     246   2670 my ($document, $elem) = @_;
57 246         473 @constants{ _use_constants($elem) } = 1; # hash slice
58 246         497 push @violations, _one_violate ($self, $elem, $constants);
59 246         1506 return 0; # no-match, and continue
60 14         86 });
61 14         223 return @violations;
62             }
63              
64             sub _one_violate {
65 246     246   436 my ($self, $elem, $constants) = @_;
66 246 100       687 if (! $elem->isa ('PPI::Token::Word')) { return; }
  203         352  
67              
68             # eg. "use constant FOO => 123; if (FOO < 456) {}" is ok, for a constant
69             # defined at the point in question
70 43 100       118 if (exists $constants->{$elem->content}) { return; }
  11         57  
71              
72             # eg "time < 123" is ok
73 32 100       195 if (is_perl_builtin_with_no_arguments ($elem)) { return; }
  1         27  
74              
75             # eg. "bar" in "$foo->bar < 123" is ok
76 31 100       761 if (is_method_call ($elem)) { return; }
  3         140  
77              
78             # eg. "Foo" in "require Foo" is not a constant
79 28 100       961 if (is_included_module_name ($elem)) { return; }
  7         286  
80              
81              
82             # must be followed by "<" like "MYBAREWORD < 123"
83 21 50       671 my $lt = $elem->snext_sibling or return;
84 21 100       508 $lt->isa('PPI::Token::Operator') or return;
85 10 100       27 $lt->content eq '<' or return;
86              
87             # if a ">" somewhere later like "foo <...>" then it's probably a function
88             # call on a readline or glob
89             #
90 6         32 my $after = $lt;
91 6         13 for (;;) {
92 16 100       71 $after = $after->snext_sibling or last;
93 11 100       249 if ($after->content eq '>') {
94 1         7 return;
95             }
96             }
97              
98 5         128 return $self->violation ('Bareword constant before "<"',
99             '', $elem);
100             }
101              
102             # $elem is any element. If it's a "use constants" or a "sub foo () { ...}"
103             # then return the name or names of the constants so created. Otherwise
104             # return an empty list.
105             #
106             # Perl::Critic::StricterSubs::Utils::find_declared_constant_names() does
107             # some similar stuff, but it crunches the whole document at once, instead of
108             # just one statement.
109             #
110             my %constant_modules = ('constant' => 1, 'constant::defer' => 1);
111             sub _use_constants {
112 529     529   97922 my ($elem) = @_;
113              
114 529 100       1577 if ($elem->isa ('PPI::Statement::Sub')) {
115 10         44 my $prototype = $elem->prototype;
116             ### $prototype
117 10 100 100     507 if (defined $prototype && $prototype eq '') { # prototype ()
118 4 50       20 if (my $name = $elem->name) {
119 4         134 return $name;
120             }
121             }
122             # anonymous sub or without prototype
123 6         20 return;
124             }
125              
126             return unless ($elem->isa ('PPI::Statement::Include')
127             && $elem->type eq 'use'
128 519 100 100     1636 && $constant_modules{$elem->module || ''});
      50        
      66        
129              
130 30 100       1553 $elem = $elem->schild(2) or return; # could be "use constant" alone
131             ### start at: $elem->content
132              
133 29         605 my $single = 1;
134 29 100       152 if ($elem->isa ('PPI::Structure::Constructor')) {
    100          
135             # multi-constant "use constant { FOO => 1, BAR => 2 }"
136             #
137             # PPI::Structure::Constructor { ... }
138             # PPI::Statement
139             # PPI::Token::Word 'foo'
140             #
141 8         17 $single = 0;
142             # multiple constants
143 8 100       27 $elem = $elem->schild(0)
144             or return; # empty on "use constant {}"
145 6         148 goto SKIPSTATEMENT;
146              
147             } elsif ($elem->isa ('PPI::Structure::List')) {
148             # single constant in parens "use constant (FOO => 1,2,3)"
149             #
150             # PPI::Structure::List ( ... )
151             # PPI::Statement::Expression
152             # PPI::Token::Word 'Foo'
153             #
154 4 100       58 $elem = $elem->schild(0)
155             or return; # empty on "use constant {}"
156              
157             SKIPSTATEMENT:
158 8 50       51 if ($elem->isa ('PPI::Statement')) {
159 8 50       25 $elem = $elem->schild(0) or return;
160             }
161             }
162              
163             # split_nodes_on_comma() handles oddities like "use constant qw(FOO 1)"
164             #
165 25         151 my @nodes = _elem_and_ssiblings ($elem);
166 25         111 my @arefs = split_nodes_on_comma (@nodes);
167              
168             ### @arefs
169              
170 25 100       2924 if ($single) {
171 19         81 $#arefs = 0; # first elem only
172             }
173 25         67 my @constants;
174 25         75 for (my $i = 0; $i < @arefs; $i += 2) {
175 30         64 my $aref = $arefs[$i];
176 30 50       72 if (@$aref == 1) {
177 30         60 my $name_elem = $aref->[0];
178 30 100       117 if (! $name_elem->isa ('PPI::Token::Structure')) { # not final ";"
179 29 100       148 push @constants, ($name_elem->can('string')
180             ? $name_elem->string
181             : $name_elem->content);
182 29         167 next;
183             }
184             }
185             ### ConstantBeforeLt skip non-name constant: $aref
186             }
187 25         118 return @constants;
188             }
189              
190             sub _elem_and_ssiblings {
191 78     78   269 my ($elem) = @_;
192 78         181 my @ret;
193 78         306 while ($elem) {
194 550         12536 push @ret, $elem;
195 550         1441 $elem = $elem->snext_sibling;
196             }
197 78         2579 return @ret;
198             }
199              
200             1;
201             __END__
202              
203             =for stopwords bareword autoloaded unprototyped readline parens ConstantBeforeLt POSIX Bareword filehandle mis-ordering Ryde emphasises prototyped
204              
205             =head1 NAME
206              
207             Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt - disallow bareword before <
208              
209             =head1 DESCRIPTION
210              
211             This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
212             add-on. It prohibits a bareword before a C<E<lt>> to keep you out of trouble
213             with autoloaded or unprototyped constant subs since a C<E<lt>> in that case
214             is interpreted as the start of a C<E<lt>..E<gt>> glob or readline instead of
215             a less-than. This policy is under the "bugs" theme (see
216             L<Perl::Critic/POLICY THEMES>).
217              
218             use POSIX;
219             DBL_MANT_DIG < 32 # bad, perl 5.8 thinks <>
220              
221             func <*.c> # ok, actual glob
222             time < 2e9 # ok, builtins parse ok
223              
224             use constant FOO => 16;
225             FOO < 32 # ok, your own const
226              
227             sub BAR () { 64 }
228             BAR < 32 # ok, your own prototyped sub
229              
230             The fix for something like C<DBL_MANT_DIG E<lt> 10> is parens either around
231             or after, like
232              
233             (DBL_MANT_DIG) < 10 # ok
234             DBL_MANT_DIG() < 10 # ok
235              
236             whichever you think is less worse. The latter emphasises it's really a sub.
237              
238             The key is whether the constant sub in question is defined and has a
239             prototype at the time the code is compiled. ConstantBeforeLt makes the
240             pessimistic assumption that anything except C<use constant> and prototyped
241             subs in your own file shouldn't be relied on.
242              
243             In practice the most likely problems are with the C<POSIX> module constants
244             of Perl 5.8.x and earlier, since they were unprototyped. The default code
245             generated by C<h2xs> (as of Perl 5.10.0) is similar autoloaded unprototyped
246             constants so modules using the bare output of that suffer too.
247              
248             If you're confident the modules you use don't play tricks with their
249             constants (including only using POSIX on Perl 5.10.0 or higher) then you
250             might find ConstantBeforeLt too pessimistic. It normally triggers rather
251             rarely anyway, but you can always disable it altogether in your
252             F<.perlcriticrc> file (see L<Perl::Critic/CONFIGURATION>),
253              
254             [-ValuesAndExpressions::ConstantBeforeLt]
255              
256             =head1 OTHER NOTES
257              
258             Bareword file handles might be misinterpreted by this policy as constants,
259             but in practice "<" doesn't get used with anything taking a bare filehandle.
260              
261             A constant used before it's defined, like
262              
263             if (FOO < 123) { ... } # bad
264             ...
265             use constant FOO => 456;
266              
267             is reported by ConstantBeforeLt since it might be an imported constant sub,
268             even if it's much more likely to be a simple mis-ordering, which C<use
269             strict> picks up anyway when it runs.
270              
271             =head1 SEE ALSO
272              
273             L<Perl::Critic::Pulp>,
274             L<Perl::Critic>
275              
276             =head1 HOME PAGE
277              
278             http://user42.tuxfamily.org/perl-critic-pulp/index.html
279              
280             =head1 COPYRIGHT
281              
282             Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Kevin Ryde
283              
284             Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
285             under the terms of the GNU General Public License as published by the Free
286             Software Foundation; either version 3, or (at your option) any later
287             version.
288              
289             Perl-Critic-Pulp is distributed in the hope that it will be useful, but
290             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
291             or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
292             more details.
293              
294             You should have received a copy of the GNU General Public License along with
295             Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
296              
297             =cut