File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.pm
Criterion Covered Total %
statement 64 67 95.5
branch 32 44 72.7
condition 9 12 75.0
subroutine 17 17 100.0
pod 4 5 80.0
total 126 145 86.9


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