Login
Clean up some self-compliance issues now that MagicNumbers
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / ValuesAndExpressions / ProhibitMagicNumbers.pm
CommitLineData
d6dc5ff8
ES
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers;
9
10use strict;
11use warnings;
12
13use Readonly;
14
15use Perl::Critic::Utils qw{ :booleans :characters :severities :data_conversion };
16
17use base 'Perl::Critic::Policy';
18
19our $VERSION = '1.082';
20
21#----------------------------------------------------------------------------
22
23Readonly::Scalar my $EXPL =>
24 q{Unnamed numeric literals make code less maintainable};
25Readonly::Scalar my $USE_READONLY_OR_CONSTANT =>
26 ' Use the Readonly module or the "constant" pragma instead';
27Readonly::Scalar my $TYPE_NOT_ALLOWED_SUFFIX =>
28 ") are not allowed.$USE_READONLY_OR_CONSTANT";
29
30Readonly::Scalar my $UNSIGNED_NUMBER =>
29e94807 31 qr{
d6dc5ff8
ES
32 \d+ (?: [$PERIOD] \d+ )? # 1, 1.5, etc.
33 | [$PERIOD] \d+ # .3, .7, etc.
29e94807 34 }xms;
d6dc5ff8 35Readonly::Scalar my $SIGNED_NUMBER => qr/ [-+]? $UNSIGNED_NUMBER /xms;
29e94807
ES
36
37# The regex is already simplified. There's just a lot of variable use.
38## no critic (ProhibitComplexRegexes)
d6dc5ff8 39Readonly::Scalar my $RANGE =>
29e94807 40 qr{
d6dc5ff8
ES
41 \A
42 ($SIGNED_NUMBER)
43 [$PERIOD] [$PERIOD]
44 ($SIGNED_NUMBER)
45 (?:
46 [$COLON] by [$LEFT_PAREN]
47 ($UNSIGNED_NUMBER)
48 [$RIGHT_PAREN]
49 )?
50 \z
29e94807
ES
51 }xms;
52## use critic
d6dc5ff8
ES
53
54Readonly::Scalar my $SPECIAL_ARRAY_SUBSCRIPT_EXEMPTION => -1;
55
56Readonly::Hash my %READONLY_SUBROUTINES =>
57 hashify(
58 qw{ Readonly Readonly::Scalar Readonly::Array Readonly::Hash }
59 );
60
61#----------------------------------------------------------------------------
62
63sub supported_parameters {
64 return (
65 {
66 name => 'allowed_values',
67 description => 'Individual and ranges of values to allow, and/or "all_integers".',
68 default_string => '0 1 2',
69 parser => \&_parse_allowed_values,
70 },
71 {
72 name => 'allowed_types',
73 description => 'Kind of literals to allow.',
74 default_string => 'Float',
75 behavior => 'enumeration',
76 enumeration_values => [ qw{ Binary Exp Float Hex Octal } ],
77 enumeration_allow_multiple_values => 1,
78 },
79 );
80}
81
82sub default_severity { return $SEVERITY_LOW }
83sub default_themes { return qw( core maintenance ) }
84sub applies_to { return 'PPI::Token::Number' }
85
86#----------------------------------------------------------------------------
87
88sub initialize_if_enabled {
89 my ($self, $config) = @_;
90
91 $self->_determine_checked_types();
92
93 return $TRUE;
94}
95
96sub _parse_allowed_values {
97 my ($self, $parameter, $config_string) = @_;
98
99 my ( $all_integers_allowed, $allowed_values )
100 = _determine_allowed_values($config_string);
101
102 my $allowed_string = ' is not one of the allowed literal values (';
103 if ($all_integers_allowed) {
104 $allowed_string .= 'all integers';
105
106 if ( %{$allowed_values} ) {
107 $allowed_string .= ', ';
108 }
109 }
110 $allowed_string
111 .= ( join ', ', sort { $a <=> $b } keys %{$allowed_values} ) . ').'
112 . $USE_READONLY_OR_CONSTANT;
113
114 $self->{_allowed_values} = $allowed_values;
115 $self->{_all_integers_allowed} = $all_integers_allowed;
116 $self->{_allowed_string} = $allowed_string;
117
118 return;
119}
120
121sub _determine_allowed_values {
122 my $config_string = shift;
123
124 my @allowed_values;
125 my @potential_allowed_values;
126 my $all_integers_allowed = 0;
127
128 if ( defined $config_string ) {
129 my @allowed_values_strings =
130 grep {$_} split m/\s+/xms, $config_string;
131
132 foreach my $value_string (@allowed_values_strings) {
133 if ($value_string eq 'all_integers') {
134 $all_integers_allowed = 1;
135 } elsif ( $value_string =~ m/ \A $SIGNED_NUMBER \z /xms ) {
136 push @potential_allowed_values, $value_string + 0;
137 } elsif ( $value_string =~ m/$RANGE/xms ) {
138 my ( $minimum, $maximum, $increment ) = ($1, $2, $3);
139 $increment ||= 1;
140
141 $minimum += 0;
142 $maximum += 0;
143 $increment += 0;
144
145 for ( ## no critic (ProhibitCStyleForLoops)
146 my $value = $minimum;
147 $value <= $maximum;
148 $value += $increment
149 ) {
150 push @potential_allowed_values, $value;
151 }
152 } else {
153 die q{Invalid value for allowed_values: }, $value_string,
154 q{. Must be a number, a number range, or},
155 qq{ "all_integers".\n};
156 }
157 }
158
159 if ($all_integers_allowed) {
160 @allowed_values = grep { $_ != int $_ } @potential_allowed_values;
161 } else {
162 @allowed_values = @potential_allowed_values;
163 }
164 } else {
165 @allowed_values = (2);
166 }
167
168 if ( not $all_integers_allowed ) {
169 push @allowed_values, 0, 1;
170 }
171 my %allowed_values = hashify(@allowed_values);
172
173 return ( $all_integers_allowed, \%allowed_values );
174}
175
176sub _determine_checked_types {
177 my $self = shift;
178
179 my %checked_types = (
180 'PPI::Token::Number::Binary' => 'Binary literals (',
181 'PPI::Token::Number::Float' => 'Floating-point literals (',
182 'PPI::Token::Number::Exp' => 'Exponential literals (',
183 'PPI::Token::Number::Hex' => 'Hexadecimal literals (',
184 'PPI::Token::Number::Octal' => 'Octal literals (',
185 'PPI::Token::Number::Version' => 'Version literals (',
186 );
187
188 # This will be set by the enumeration behavior specified in
189 # supported_parameters() above.
190 my $allowed_types = $self->{_allowed_types};
191
192 foreach my $allowed_type ( keys %{$allowed_types} ) {
193 delete $checked_types{"PPI::Token::Number::$allowed_type"};
194
195 if ( $allowed_type eq 'Exp' ) {
196
197 # because an Exp isa(Float).
198 delete $checked_types{'PPI::Token::Number::Float'};
199 }
200 }
201
202 $self->{_checked_types} = \%checked_types;
203
204 return;
205}
206
207
208sub violates {
209 my ( $self, $elem, undef ) = @_;
210
211 return if PPI->VERSION le '1.118';
212
213 return if _element_is_in_an_include_readonly_or_version_statement($elem);
214
215 my $literal = $elem->literal();
216 if (
217 defined $literal
218 and not (
219 $self->{_all_integers_allowed}
220 and int $literal == $literal
221 )
222 and not defined $self->{_allowed_values}{$literal}
223 and not (
224 _element_is_sole_component_of_a_subscript($elem)
225 and $literal == $SPECIAL_ARRAY_SUBSCRIPT_EXEMPTION
226 )
227 ) {
228 return
229 $self->violation(
230 $elem->content() . $self->{_allowed_string},
231 $EXPL,
232 $elem,
233 );
234 }
235
236
237 my ( $number_type, $type_string );
238
239 while (
240 ( $number_type, $type_string ) = ( each %{ $self->{_checked_types} } )
241 ) {
242 if ( $elem->isa($number_type) ) {
243 return
244 $self->violation(
245 $type_string . $elem->content() . $TYPE_NOT_ALLOWED_SUFFIX,
246 $EXPL,
247 $elem,
248 );
249 }
250 }
251
252 return;
253}
254
255sub _element_is_sole_component_of_a_subscript {
256 my $elem = shift;
257
258 my $parent = $elem->parent();
259 if ( $parent and $parent->isa('PPI::Statement::Expression') ) {
260 if ( $parent->schildren() > 1 ) {
261 return 0;
262 }
263
264 my $grandparent = $parent->parent();
265 if (
266 $grandparent
267 and $grandparent->isa('PPI::Structure::Subscript')
268 ) {
269 return 1;
270 }
271 }
272
273 return 0;
274}
275
276sub _element_is_in_an_include_readonly_or_version_statement {
277 my $elem = shift;
278
279 my $parent = $elem->parent();
280 while ($parent) {
281 if ( $parent->isa('PPI::Statement') ) {
282 return 1 if $parent->isa('PPI::Statement::Include');
283
284 if ( $parent->isa('PPI::Statement::Variable') ) {
285 if ( $parent->type() eq 'our' ) {
286 my @variables = $parent->variables();
287 if (
288 scalar @variables == 1
289 and $variables[0] eq '$VERSION' ##no critic (RequireInterpolationOfMetachars)
290 ) {
291 return 1;
292 }
293 }
294
295 return 0;
296 }
297
298 my $first_token = $parent->first_token();
299 if ( $first_token->isa('PPI::Token::Word') ) {
300 if ( exists $READONLY_SUBROUTINES{$first_token} ) {
301 return 1;
302 }
303 }
304
305 # Uncomment once PPI bug fixed.
306 # } elsif ($parent->isa('PPI::Structure::Block')) {
307 # return 0;
308 }
309
310 $parent = $parent->parent();
311 }
312
313 return 0;
314}
315
3161;
317
318__END__
319
320#----------------------------------------------------------------------------
321
322=pod
323
324=for stopwords
325
326=head1 NAME
327
328Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers
329
330
331=head1 DESCRIPTION
332
333What is a "magic number"? A magic number is a number that appears in
334code without any explanation; e.g. C<$bank_account_balance *=
33557.492;>. You look at that number and have to wonder where that
336number came from. Since you don't understand the significance of the
337number, you don't understand the code.
338
339In general, numeric literals other than C<0> or C<1> in should not be
340used. Use the L<constant> pragma or the L<Readonly> module to give a
341descriptive name to the number.
342
343There are, of course, exceptions to when this rule should be applied.
344One good example is positioning of objects in some container like
345shapes on a blueprint or widgets in a user interface. In these cases,
346the significance of a number can readily be determined by context.
347
348
349=head2 Ways in which this module applies this rule.
350
351By default, this rule is relaxed in that C<2> is permitted to allow
352for common things like alternation, the STDERR file handle, etc..
353
354Numeric literals are allowed in C<use> and C<require> statements to
355allow for things like Perl version restrictions and L<Test::More>
356plans. Declarations of C<$VERSION> package variables are permitted.
357Use of C<Readonly>, C<Readonly::Scalar>, C<Readonly::Array>, and
358C<Readonly::Hash> from the L<Readonly> module are obviously valid, but
359use of C<Readonly::Scalar1>, C<Readonly::Array1>, and
360C<Readonly::Hash1> are specifically not supported.
361
362Use of binary, exponential, hexadecimal, octal, and version numbers,
363even for C<0> and C<1>, outside of C<use>/C<require>/C<Readonly>
364statements aren't permitted (but you can change this).
365
366There is a special exemption for accessing the last element of an
367array, i.e. C<$x[-1]>.
368
369
370 $x = 0; #ok
371 $x = 0.0; #ok
372 $x = 1; #ok
373 $x = 1.0; #ok
374 $x = 1.5; #not ok
375 $x = 0b0 #not ok
376 $x = 0b1 #not ok
377 $x = 0x00 #not ok
378 $x = 0x01 #not ok
379 $x = 000 #not ok
380 $x = 001 #not ok
381 $x = 0e1 #not ok
382 $x = 1e1 #not ok
383
384 $frobnication_factor = 42; #not ok
385 use constant FROBNICATION_FACTOR => 42; #ok
386
387
388 use 5.6.1; #ok
389 use Test::More plan => 57; #ok
390 our $VERSION = 0.22; #ok
391
392
393 $x = $y[-1] #ok
394 $x = $y[-2] #not ok
395
396
397
398 foreach my $solid (1..5) { #not ok
399 ...
400 }
401
402
403 use Readonly;
404
405 Readonly my $REGULAR_GEOMETRIC_SOLIDS => 5;
406
407 foreach my $solid (1..$REGULAR_GEOMETRIC_SOLIDS) { #ok
408 ...
409 }
410
411
412=head1 CONFIGURATION
413
414This policy has two options: C<allowed_values> and C<allowed_types>.
415
416
417=head2 C<allowed_values>
418
419The C<allowed_values> parameter is a whitespace delimited set of
420permitted number I<values>; this does not affect the permitted formats
421for numbers. The defaults are equivalent to having the following in
422your F<.perlcriticrc>:
423
424 [ValuesAndExpressions::ProhibitMagicNumbers]
425 allowed_values = 0 1 2
426
427Note that this policy forces the values C<0> and C<1> into the
428permitted values. Thus, specifying no values,
429
430 allowed_values =
431
432is the same as simply listing C<0> and C<1>:
433
434 allowed_values = 0 1
435
436The special C<all_integers> value, not surprisingly, allows all
437integral values to pass, subject to the restrictions on number types.
438
439Ranges can be specified as two (possibly fractional) numbers separated
440by two periods, optionally suffixed with an increment using the Perl 6
441C<:by()> syntax. E.g.
442
443 allowed_values = 7..10
444
445will allow 0, 1, 7, 8, 9, and 10 as literal values. Using fractional
446values like so
447
448 allowed_values = -3.5..-0.5:by(0.5)
449
450will permit -3.5, -3, -2.5, -2, -2.5, -1, -0.5, 0, and 1.
451Unsurprisingly, the increment defaults to 1, which means that
452
453 allowed_values = -3.5..-0.5
454
455will make -3.5, -2.5, -2.5, -0.5, 0, and 1 valid.
456
457Ranges are not lazy, i.e. you'd better have a lot of memory available
458if you use a range of C<1..1000:by(0.01)>. Also remember that all of
459this is done using floating-point math, which means that
460C<1..10:by(0.3333)> is probably not going to be very useful.
461
462Specifying an upper limit that is less than the lower limit will
463result in no values being produced by that range. Negative increments
464are not permitted.
465
466Multiple ranges are permitted.
467
468To put this all together, the following is a valid, though not likely
469to be used, F<.perlcriticrc> entry:
470
471 [ValuesAndExpressions::ProhibitMagicNumbers]
472 allowed_values = 3.1415269 82..103 -507.4..57.8:by(0.2) all_integers
473
474
475=head2 C<allowed_types>
476
477The C<allowed_types> parameter is a whitespace delimited set of
478subclasses of L<PPI::Token::Number>.
479
480Decimal integers are always allowed. By default, floating-point
481numbers are also allowed.
482
483For example, to allow hexadecimal literals, you could configure this
484policy like
485
486 [ValuesAndExpressions::ProhibitMagicNumbers]
487 allowed_types = Hex
488
489but without specifying anything for C<allowed_values>, the allowed
490hexadecimal literals will be C<0x00>, C<0x01>, and C<0x02>. Note,
491also, as soon as you specify a value for this parameter, you must
492include C<Float> in the list to continue to be able to use floating
493point literals. This effect can be used to restrict literals to only
494decimal integers:
495
496 [ValuesAndExpressions::ProhibitMagicNumbers]
497 allowed_types =
498
499If you permit exponential notation, you automatically also allow
500floating point values because an exponential is a subclass of
501floating-point in L<PPI>.
502
503
504=head1 BUGS
505
506There is currently no way to permit version numbers in regular code,
507even if you include them in the allowed_types. Some may actually
508consider this a feature.
509
510
511=head1 AUTHOR
512
513Elliot Shank C<< <perl@galumph.com> >>
514
515
516=head1 COPYRIGHT
517
518Copyright (c) 2006-2008 Elliot Shank. All rights reserved.
519
520This program is free software; you can redistribute it and/or modify
521it under the same terms as Perl itself. The full text of this license
522can be found in the LICENSE file included with this module.
523
524=cut
525
526# Local Variables:
527# mode: cperl
528# cperl-indent-level: 4
529# fill-column: 78
530# indent-tabs-mode: nil
531# c-indentation-style: bsd
532# End:
533# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab :