git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.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::ProhibitCommaSeparatedStatements;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15
  16 use Perl::Critic::Utils qw{ :booleans :characters :severities :classification };
  17 use Perl::Critic::Utils::PPI qw{ is_ppi_statement_subclass };
  18
  19 use base 'Perl::Critic::Policy';
  20
  21 our $VERSION = '1.088';
  22
  23 #-----------------------------------------------------------------------------
  24
  25 Readonly::Scalar my $DESC => q{Comma used to separate statements};
  26 Readonly::Scalar my $EXPL => [ 68, 71 ];
  27
  28 #-----------------------------------------------------------------------------
  29
  30 sub supported_parameters {
  31     return (
  32         {
  33             name           => 'allow_last_statement_to_be_comma_separated_in_map_and_grep',
  34             description    => 'Allow map and grep blocks to return lists.',
  35             default_string => $FALSE,
  36             behavior       => 'boolean',
  37         },
  38     );
  39 }
  40
  41 sub default_severity     { return $SEVERITY_HIGH      }
  42 sub default_themes       { return qw( core bugs pbp ) }
  43 sub applies_to           { return 'PPI::Statement'    }
  44
  45 #-----------------------------------------------------------------------------
  46
  47 sub violates {
  48     my ( $self, $elem, undef ) = @_;
  49
  50     # Grrr... PPI instantiates non-leaf nodes in its class hierarchy...
  51     return if is_ppi_statement_subclass($elem);
  52
  53     # Now, if PPI hasn't introduced any new PPI::Statement subclasses, we've
  54     # got an element who's class really is PPI::Statement.
  55
  56     return if _is_parent_a_constructor_or_list($elem);
  57     return if _is_parent_a_for_loop($elem);
  58
  59     if (
  60         $self->{_allow_last_statement_to_be_comma_separated_in_map_and_grep}
  61     ) {
  62         return if not _is_direct_part_of_map_or_grep_block($elem);
  63     }
  64
  65     foreach my $child ( $elem->schildren() ) {
  66         if (
  67                 not $self->{_allow_last_statement_to_be_comma_separated_in_map_and_grep}
  68             and not _is_last_statement_in_a_block($child)
  69         ) {
  70             if ( $child->isa('PPI::Token::Word') ) {
  71                 return if _succeeding_commas_are_list_element_separators($child);
  72             }
  73             elsif ( $child->isa('PPI::Token::Operator') ) {
  74                 if ( $child->content() eq $COMMA ) {
  75                     return $self->violation($DESC, $EXPL, $elem);
  76                 }
  77             }
  78         }
  79     }
  80
  81     return;
  82 }
  83
  84 sub _is_parent_a_constructor_or_list {
  85     my ($elem) = @_;
  86
  87     my $parent = $elem->parent();
  88
  89     return if not $parent;
  90
  91     return (
  92             $parent->isa('PPI::Structure::Constructor')
  93         or  $parent->isa('PPI::Structure::List')
  94     );
  95 }
  96
  97 sub _is_parent_a_for_loop {
  98     my ($elem) = @_;
  99
 100     my $parent = $elem->parent();
 101
 102     return if not $parent;
 103
 104     return if not $parent->isa('PPI::Structure::ForLoop');
 105
 106     return 1 == scalar $parent->schildren(); # Multiple means C-style loop.
 107 }
 108
 109 sub _is_direct_part_of_map_or_grep_block {
 110     my ($elem) = @_;
 111
 112     my $parent = $elem->parent();
 113     return if not $parent;
 114     return if not $parent->isa('PPI::Structure::Block');
 115
 116     my $block_prior_sibling = $parent->sprevious_sibling();
 117     return if not $block_prior_sibling;
 118     return if not $block_prior_sibling->isa('PPI::Token::Word');
 119
 120     return $block_prior_sibling eq 'map' || $block_prior_sibling eq 'grep';
 121 }
 122
 123 sub _is_last_statement_in_a_block {
 124     my ($elem) = @_;
 125
 126     my $parent = $elem->parent();
 127     return if not $parent;
 128     return if not $parent->isa('PPI::Structure::Block');
 129
 130     my $next_sibling = $elem->snext_sibling();
 131     return if not $next_sibling;
 132
 133     return 1;
 134 }
 135
 136 sub _succeeding_commas_are_list_element_separators {
 137     my ($elem) = @_;
 138
 139     if (
 140             is_perl_builtin_with_zero_and_or_one_arguments($elem)
 141         and not is_perl_builtin_with_multiple_arguments($elem)
 142     ) {
 143         return;
 144     }
 145
 146     my $sibling = $elem->snext_sibling();
 147
 148     return 1 if not $sibling;  # There won't be any succeeding commas.
 149
 150     return not $sibling->isa('PPI::Structure::List');
 151 }
 152
 153 1;
 154
 155 __END__
 156
 157 #-----------------------------------------------------------------------------
 158
 159 =pod
 160
 161 =head1 NAME
 162
 163 Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements - Don't use the comma operator as a statement separator.
 164
 165 =head1 AFFILIATION
 166
 167 This Policy is part of the core L<Perl::Critic> distribution.
 168
 169
 170 =head1 DESCRIPTION
 171
 172 Perl's comma statement separator has really low precedence, which
 173 leads to code that looks like it's using the comma list element
 174 separator not actually doing so.  Conway suggests that the statement
 175 separator not be used in order to prevent this situation.
 176
 177 The confusion that the statement separator causes is primarily due to
 178 the assignment operators having higher precedence.
 179
 180 For example, trying to combine two arrays into another like this won't
 181 work:
 182
 183   @x = @y, @z;
 184
 185 because it is equivalent to
 186
 187   @x = @y;
 188   @z;
 189
 190 Conversely, there are the built-in functions, like C<print>, that
 191 normally force the rest of the statement into list context, but don't
 192 when called like a subroutine.
 193
 194 This is not likely to produce what is intended:
 195
 196   print join q{, }, 2, 3, 5, 7, ": the single-digit primes.\n";
 197
 198 The obvious fix is to add parentheses.  Placing them like
 199
 200   print join( q{, }, 2, 3, 5, 7 ), ": the single-digit primes.\n";
 201
 202 will work, but
 203
 204   print ( join q{, }, 2, 3, 5, 7 ), ": the single-digit primes.\n";
 205
 206 will not, because it is equivalent to
 207
 208   print( join q{, }, 2, 3, 5, 7 );
 209   ": the single-digit primes.\n";
 210
 211
 212 =head1 CONFIGURATION
 213
 214 This policy can be configured to allow the last statement in a C<map>
 215 or C<grep> block to be comma separated.  This is done via the
 216 C<allow_last_statement_to_be_comma_separated_in_map_and_grep> option
 217 like so:
 218
 219   [ValuesAndExpressions::ProhibitCommaSeparatedStatements]
 220   allow_last_statement_to_be_comma_separated_in_map_and_grep = 1
 221
 222 With this option off (the default), the following code violates this
 223 policy.
 224
 225   %hash = map {$_, 1} @list;
 226
 227 With this option on, this statement is allowed.  Even if this option
 228 is off, using a fat comma C<< => >> works, but that forces
 229 stringification on the first value, which may not be what you want.
 230
 231 =head1 AUTHOR
 232
 233 Elliot Shank C<< <perl@galumph.com> >>
 234
 235 =head1 COPYRIGHT
 236
 237 Copyright (c) 2007-2008 Elliot Shank.  All rights reserved.
 238
 239 This program is free software; you can redistribute it and/or modify
 240 it under the same terms as Perl itself.  The full text of this license
 241 can be found in the LICENSE file included with this module.
 242
 243 =cut
 244
 245 # Local Variables:
 246 #   mode: cperl
 247 #   cperl-indent-level: 4
 248 #   fill-column: 78
 249 #   indent-tabs-mode: nil
 250 #   c-indentation-style: bsd
 251 # End:
 252 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :