vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMagicNumbers.pm

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