--- /dev/null
+##############################################################################
+# $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.pm $
+# $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
+# $Author: clonezone $
+# $Revision: 2489 $
+##############################################################################
+
+package Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements;
+
+use 5.006001;
+use strict;
+use warnings;
+use Readonly;
+
+
+use Perl::Critic::Utils qw{ :booleans :characters :severities :classification };
+use Perl::Critic::Utils::PPI qw{ is_ppi_statement_subclass };
+
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '1.088';
+
+#-----------------------------------------------------------------------------
+
+Readonly::Scalar my $DESC => q{Comma used to separate statements};
+Readonly::Scalar my $EXPL => [ 68, 71 ];
+
+#-----------------------------------------------------------------------------
+
+sub supported_parameters {
+ return (
+ {
+ name => 'allow_last_statement_to_be_comma_separated_in_map_and_grep',
+ description => 'Allow map and grep blocks to return lists.',
+ default_string => $FALSE,
+ behavior => 'boolean',
+ },
+ );
+}
+
+sub default_severity { return $SEVERITY_HIGH }
+sub default_themes { return qw( core bugs pbp ) }
+sub applies_to { return 'PPI::Statement' }
+
+#-----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, undef ) = @_;
+
+ # Grrr... PPI instantiates non-leaf nodes in its class hierarchy...
+ return if is_ppi_statement_subclass($elem);
+
+ # Now, if PPI hasn't introduced any new PPI::Statement subclasses, we've
+ # got an element who's class really is PPI::Statement.
+
+ return if _is_parent_a_constructor_or_list($elem);
+ return if _is_parent_a_for_loop($elem);
+
+ if (
+ $self->{_allow_last_statement_to_be_comma_separated_in_map_and_grep}
+ ) {
+ return if not _is_direct_part_of_map_or_grep_block($elem);
+ }
+
+ foreach my $child ( $elem->schildren() ) {
+ if (
+ not $self->{_allow_last_statement_to_be_comma_separated_in_map_and_grep}
+ and not _is_last_statement_in_a_block($child)
+ ) {
+ if ( $child->isa('PPI::Token::Word') ) {
+ return if _succeeding_commas_are_list_element_separators($child);
+ }
+ elsif ( $child->isa('PPI::Token::Operator') ) {
+ if ( $child->content() eq $COMMA ) {
+ return $self->violation($DESC, $EXPL, $elem);
+ }
+ }
+ }
+ }
+
+ return;
+}
+
+sub _is_parent_a_constructor_or_list {
+ my ($elem) = @_;
+
+ my $parent = $elem->parent();
+
+ return if not $parent;
+
+ return (
+ $parent->isa('PPI::Structure::Constructor')
+ or $parent->isa('PPI::Structure::List')
+ );
+}
+
+sub _is_parent_a_for_loop {
+ my ($elem) = @_;
+
+ my $parent = $elem->parent();
+
+ return if not $parent;
+
+ return if not $parent->isa('PPI::Structure::ForLoop');
+
+ return 1 == scalar $parent->schildren(); # Multiple means C-style loop.
+}
+
+sub _is_direct_part_of_map_or_grep_block {
+ my ($elem) = @_;
+
+ my $parent = $elem->parent();
+ return if not $parent;
+ return if not $parent->isa('PPI::Structure::Block');
+
+ my $block_prior_sibling = $parent->sprevious_sibling();
+ return if not $block_prior_sibling;
+ return if not $block_prior_sibling->isa('PPI::Token::Word');
+
+ return $block_prior_sibling eq 'map' || $block_prior_sibling eq 'grep';
+}
+
+sub _is_last_statement_in_a_block {
+ my ($elem) = @_;
+
+ my $parent = $elem->parent();
+ return if not $parent;
+ return if not $parent->isa('PPI::Structure::Block');
+
+ my $next_sibling = $elem->snext_sibling();
+ return if not $next_sibling;
+
+ return 1;
+}
+
+sub _succeeding_commas_are_list_element_separators {
+ my ($elem) = @_;
+
+ if (
+ is_perl_builtin_with_zero_and_or_one_arguments($elem)
+ and not is_perl_builtin_with_multiple_arguments($elem)
+ ) {
+ return;
+ }
+
+ my $sibling = $elem->snext_sibling();
+
+ return 1 if not $sibling; # There won't be any succeeding commas.
+
+ return not $sibling->isa('PPI::Structure::List');
+}
+
+1;
+
+__END__
+
+#-----------------------------------------------------------------------------
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements - Don't use the comma operator as a statement separator.
+
+=head1 AFFILIATION
+
+This Policy is part of the core L<Perl::Critic> distribution.
+
+
+=head1 DESCRIPTION
+
+Perl's comma statement separator has really low precedence, which
+leads to code that looks like it's using the comma list element
+separator not actually doing so. Conway suggests that the statement
+separator not be used in order to prevent this situation.
+
+The confusion that the statement separator causes is primarily due to
+the assignment operators having higher precedence.
+
+For example, trying to combine two arrays into another like this won't
+work:
+
+ @x = @y, @z;
+
+because it is equivalent to
+
+ @x = @y;
+ @z;
+
+Conversely, there are the built-in functions, like C<print>, that
+normally force the rest of the statement into list context, but don't
+when called like a subroutine.
+
+This is not likely to produce what is intended:
+
+ print join q{, }, 2, 3, 5, 7, ": the single-digit primes.\n";
+
+The obvious fix is to add parentheses. Placing them like
+
+ print join( q{, }, 2, 3, 5, 7 ), ": the single-digit primes.\n";
+
+will work, but
+
+ print ( join q{, }, 2, 3, 5, 7 ), ": the single-digit primes.\n";
+
+will not, because it is equivalent to
+
+ print( join q{, }, 2, 3, 5, 7 );
+ ": the single-digit primes.\n";
+
+
+=head1 CONFIGURATION
+
+This policy can be configured to allow the last statement in a C<map>
+or C<grep> block to be comma separated. This is done via the
+C<allow_last_statement_to_be_comma_separated_in_map_and_grep> option
+like so:
+
+ [ValuesAndExpressions::ProhibitCommaSeparatedStatements]
+ allow_last_statement_to_be_comma_separated_in_map_and_grep = 1
+
+With this option off (the default), the following code violates this
+policy.
+
+ %hash = map {$_, 1} @list;
+
+With this option on, this statement is allowed. Even if this option
+is off, using a fat comma C<< => >> works, but that forces
+stringification on the first value, which may not be what you want.
+
+=head1 AUTHOR
+
+Elliot Shank C<< <perl@galumph.com> >>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2007-2008 Elliot Shank. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. The full text of this license
+can be found in the LICENSE file included with this module.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 78
+# indent-tabs-mode: nil
+# c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
projects / dh-make-perl / blobdiff