File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNullStatements.pm
Criterion Covered Total %
statement 64 64 100.0
branch 23 26 88.4
condition 22 28 78.5
subroutine 14 14 100.0
pod 1 1 100.0
total 124 133 93.2


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Kevin Ryde
2              
3             # This file is part of Perl-Critic-Pulp.
4              
5             # Perl-Critic-Pulp is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Perl-Critic-Pulp is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
17              
18              
19             package Perl::Critic::Policy::ValuesAndExpressions::ProhibitNullStatements;
20 40     40   32082 use 5.006;
  40         170  
21 40     40   226 use strict;
  40         98  
  40         860  
22 40     40   201 use warnings;
  40         84  
  40         1065  
23 40     40   224 use base 'Perl::Critic::Policy';
  40         91  
  40         4802  
24 40     40   196553 use Perl::Critic::Utils;
  40         112  
  40         705  
25 40     40   56566 use Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon; # for try helpers
  40         136  
  40         2527  
26              
27             our $VERSION = 98;
28              
29              
30 40         2589 use constant supported_parameters =>
31             ({ name => 'allow_perl4_semihash',
32             description => 'Whether to allow Perl 4 style ";#" comments.',
33             behavior => 'boolean',
34             default_string => '0',
35 40     40   301 });
  40         104  
36 40     40   252 use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM;
  40         90  
  40         2175  
37 40     40   243 use constant default_themes => qw(pulp cosmetic);
  40         94  
  40         2202  
38 40     40   258 use constant applies_to => ('PPI::Statement::Null', 'PPI::Token::Structure');
  40         109  
  40         23109  
39              
40             sub violates {
41 154     154 1 650433 my ($self, $elem, $document) = @_;
42              
43 154 100       481 if ($elem->isa('PPI::Statement::Null')) {
44              
45             # if allow_perl4_semihash then ";# comment ..." ok
46 19 100 100     73 if ($self->{'_allow_perl4_semihash'} && _is_perl4_semihash($elem)) {
47 2         9 return; # ok
48             }
49              
50             # "for (;;)" is ok, like
51             #
52             # PPI::Structure::ForLoop ( ... )
53             # PPI::Statement::Null
54             # PPI::Token::Structure ';'
55             # PPI::Statement::Null
56             # PPI::Token::Structure ';'
57             #
58             # or the incompatible change in ppi 1.205
59             #
60             # PPI::Token::Word 'for'
61             # PPI::Structure::For ( ... )
62             # PPI::Statement::Null
63             # PPI::Token::Structure ';'
64             # PPI::Statement::Null
65             # PPI::Token::Structure ';'
66              
67 17         78 my $parent = $elem->parent;
68 17 100 66     202 if ($parent->isa('PPI::Structure::For')
69             || $parent->isa('PPI::Structure::ForLoop')) {
70 2         20 return; # ok
71             }
72              
73             # "map {; ...}" or "grep {; ...}" ok
74 15 100       42 if (_is_block_disambiguator ($elem)) {
75 7         24 return; # ok
76             }
77             } else {
78             # PPI::Token::Structure ...
79              
80 135 100       253 if (! _is_end_of_try_block($elem)) {
81             # not a semi at the end of a try {} catch {}; block, ok
82 131         1361 return;
83             }
84             }
85              
86             # any other PPI::Statement::Null is a bare ";" and is not ok, like
87             #
88             # PPI::Statement::Null
89             # PPI::Token::Structure ';'
90             #
91 12         118 return $self->violation ('Null statement (stray semicolon)',
92             '',
93             $elem);
94             }
95              
96             my %is_try_catch_keyword = (try => 1,
97             catch => 1,
98             finally => 1);
99              
100             # $elem is a PPI::Token::Structure
101             # Return true if it's a semicolon ; at the end of a try/catch block for any
102             # Try.pm, TryCatch.pm or Syntax::Feature::Try. Such a ; is unnecessary.
103             sub _is_end_of_try_block {
104 135     135   237 my ($elem) = @_;
105              
106 135 100 100     293 ($elem->content eq ';'
107             && Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon::_elem_is_try_block($elem->parent))
108             || return 0;
109              
110             # ppidump "try {} foo(123);" gives
111             # PPI::Statement
112             # PPI::Token::Word 'try'
113             # PPI::Structure::Block { ... }
114             # PPI::Token::Word 'foo'
115             # PPI::Structure::List ( ... )
116             # PPI::Statement::Expression
117             # PPI::Token::Number '123'
118             # PPI::Token::Structure ';'
119 6         14 for (;;) {
120 15   100     82 $elem = $elem->sprevious_sibling || return 1;
121 11 100       380 $elem->isa('PPI::Structure::Block') || return 0;
122              
123 9   50     28 $elem = $elem->sprevious_sibling || return 0;
124 9 50 33     249 ($elem->isa('PPI::Token::Word') && $is_try_catch_keyword{$elem->content})
125             || return 0;
126             }
127             }
128              
129             # _is_block_disambiguator($elem) takes a PPI::Statement::Null $elem and
130             # returns true if it's at the start of a "map {; ...}" or "grep {; ...}"
131             #
132             # PPI structure like the following, with the Whitespace optional of course,
133             # and allow comments in there too in case someone wants to write "# force
134             # block" or something
135             #
136             # PPI::Token::Word 'map'
137             # PPI::Token::Whitespace ' '
138             # PPI::Structure::Block { ... }
139             # PPI::Token::Whitespace ' '
140             # PPI::Statement::Null
141             # PPI::Token::Structure ';'
142             #
143             sub _is_block_disambiguator {
144 15     15   31 my ($elem) = @_;
145              
146 15         38 my $block = $elem->parent;
147 15 100       94 $block ->isa('PPI::Structure::Block')
148             or return 0; # not in a block
149              
150             # not "sprevious" here, don't want to skip other null statements, just
151             # whitespace and comments
152 10         33 my $prev = $elem->previous_sibling;
153 10   100     272 while ($prev && ($prev->isa ('PPI::Token::Whitespace')
      100        
154             || $prev->isa ('PPI::Token::Comment'))) {
155 15         273 $prev = $prev->previous_sibling;
156             }
157 10 100       141 if ($prev) {
158 3         10 return 0; # not at the start of the block
159             }
160              
161 7 50       21 my $word = $block->sprevious_sibling
162             or return 0; # nothing preceding the block
163 7 50       241 $word->isa('PPI::Token::Word')
164             or return 0;
165 7         22 my $content = $word->content;
166 7   66     54 return ($content eq 'map' || $content eq 'grep');
167             }
168              
169             # _is_perl4_semihash($elem) takes a PPI::Statement::Null $elem and returns
170             # true if it's a Perl 4 style start-of-line ";# comment ..."
171             #
172             # When at the very start of a document,
173             #
174             # PPI::Document
175             # PPI::Statement::Null
176             # PPI::Token::Structure ';'
177             # PPI::Token::Comment '# foo'
178             #
179             # When in the middle,
180             #
181             # PPI::Token::Whitespace '\n'
182             # PPI::Statement::Null
183             # PPI::Token::Structure ';'
184             # PPI::Token::Comment '# hello'
185             #
186             sub _is_perl4_semihash {
187 4     4   11 my ($elem) = @_;
188              
189             # must be at the start of the line
190             # though not sure about this, the pl2pm program allows whitespace before
191 4 100       15 ($elem->location->[1] == 1)
192             or return 0;
193              
194             # must be immediately followed by a comment
195 3         73 my $next = $elem->next_sibling;
196 3   66     91 return ($next && $next->isa('PPI::Token::Comment'));
197             }
198              
199              
200             1;
201             __END__
202              
203             =for stopwords ie ok boolean Ryde
204              
205             =head1 NAME
206              
207             Perl::Critic::Policy::ValuesAndExpressions::ProhibitNullStatements - disallow empty statements (stray semicolons)
208              
209             =head1 DESCRIPTION
210              
211             This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
212             add-on. It prohibits empty statements, ie. bare C<;> semicolons. This can
213             be a typo doubling up a semi like
214              
215             use Foo;; # bad
216              
217             Or a stray left at the end of a control structure like
218              
219             if ($foo) {
220             print "foo\n";
221             return;
222             }; # bad
223              
224             An empty statement is harmless, so this policy is under the "cosmetic" theme
225             (see L<Perl::Critic/POLICY THEMES>) and medium severity. It's surprisingly
226             easy to leave a semi behind when chopping code around, especially when
227             changing a statement to a loop or conditional.
228              
229             =head2 Allowed forms
230              
231             A C style C<for (;;) { ...}> loop is ok. Those semicolons are expression
232             separators and empties there are quite usual.
233              
234             for (;;) { # ok
235             print "infinite loop\n";
236             }
237              
238             A semicolon at the start of a C<map> or C<grep> block is allowed. It's
239             commonly used to ensure Perl parses it as a block, not an anonymous hash.
240             (Perl decides at the point it parses the C<{>. A C<;> there forces a block
241             when it might otherwise guess wrongly. See L<perlfunc/map> for more on
242             this.)
243              
244             map {; $_, 123} @some_list; # ok
245              
246             grep {# this is a block
247             ; # ok
248             length $_ and $something } @some_list;
249              
250             The C<map> form is much more common than the C<grep>, but both suffer the
251             same ambiguity. C<grep> doesn't normally inspire people to quite such
252             convoluted forms as C<map> does.
253              
254             =head2 Try/Catch Blocks
255              
256             The C<Try>, C<TryCatch> and C<Syntax::Feature::Try> modules all add new
257             C<try> block statement forms. These statements don't require a terminating
258             semicolon (the same as an C<if> doesn't require one). Any semicolon there
259             is reckoned as a null statement.
260              
261             use TryCatch;
262             sub foo {
263             try { attempt_something() }
264             catch { error_recovery() }; # bad
265             }
266              
267             This doesn't apply to other try modules such as C<Try::Tiny> and friends.
268             They're implemented as ordinary function calls (with prototypes), so a
269             terminating semicolon is normal for them.
270              
271             use Try::Tiny;
272             sub foo {
273             try { attempt_something() }
274             catch { error_recovery() }; # ok
275             }
276              
277             =head1 CONFIGURATION
278              
279             =over 4
280              
281             =item C<allow_perl4_semihash> (boolean, default false)
282              
283             If true then Perl 4 style documentation comments like the following are
284             allowed.
285              
286             ;# Usage:
287             ;# require 'mypkg.pl';
288             ;# ...
289              
290             The C<;> must be at the start of the line. This is fairly outdated, so it's
291             disabled by default. If you're crunching through some old code you can
292             enable it by adding to your F<.perlcriticrc> file
293              
294             [ValuesAndExpressions::ProhibitNullStatements]
295             allow_perl4_semihash=1
296              
297             =back
298              
299             =head1 SEE ALSO
300              
301             L<Perl::Critic::Pulp>,
302             L<Perl::Critic>,
303             L<Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon>
304              
305             =head1 HOME PAGE
306              
307             http://user42.tuxfamily.org/perl-critic-pulp/index.html
308              
309             =head1 COPYRIGHT
310              
311             Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Kevin Ryde
312              
313             Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
314             under the terms of the GNU General Public License as published by the Free
315             Software Foundation; either version 3, or (at your option) any later
316             version.
317              
318             Perl-Critic-Pulp is distributed in the hope that it will be useful, but
319             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
320             or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
321             more details.
322              
323             You should have received a copy of the GNU General Public License along with
324             Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
325              
326             =cut