File Coverage

blib/lib/Perl/Critic/Policy/CodeLayout/RequireFinalSemicolon.pm
Criterion Covered Total %
statement 129 139 92.8
branch 55 58 94.8
condition 31 52 59.6
subroutine 25 27 92.5
pod 1 1 100.0
total 241 277 87.0


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde
2              
3             # Perl-Critic-Pulp is free software; you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by the
5             # Free Software Foundation; either version 3, or (at your option) any later
6             # version.
7             #
8             # Perl-Critic-Pulp is distributed in the hope that it will be useful, but
9             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
11             # for more details.
12             #
13             # You should have received a copy of the GNU General Public License along
14             # with Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
15              
16             package Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon;
17 40     40   1447 use 5.006;
  40         228  
18 40     40   233 use strict;
  40         102  
  40         942  
19 40     40   216 use warnings;
  40         104  
  40         1153  
20 40     40   253 use List::Util;
  40         93  
  40         2313  
21              
22 40     40   267 use base 'Perl::Critic::Policy';
  40         103  
  40         4726  
23 40     40   181000 use Perl::Critic::Utils;
  40         105  
  40         743  
24 40     40   37146 use Perl::Critic::Pulp;
  40         101  
  40         1197  
25 40     40   1747 use Perl::Critic::Pulp::Utils;
  40         112  
  40         3605  
26              
27             # uncomment this to run the ### lines
28             # use Smart::Comments;
29              
30             our $VERSION = 99;
31              
32 40         3442 use constant supported_parameters =>
33             ({ name => 'except_same_line',
34             description => 'Whether to allow no semicolon at the end of blocks with the } closing brace on the same line as the last statement.',
35             behavior => 'boolean',
36             default_string => '1',
37             },
38             { name => 'except_expression_blocks',
39             description => 'Whether to allow no semicolon at the end of do{} expression blocks.',
40             behavior => 'boolean',
41             default_string => '1',
42 40     40   305 });
  40         126  
43 40     40   293 use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW;
  40         104  
  40         2363  
44 40     40   265 use constant default_themes => qw(pulp cosmetic);
  40         109  
  40         2402  
45 40     40   269 use constant applies_to => 'PPI::Structure::Block';
  40         117  
  40         64505  
46              
47             sub violates {
48 98     98 1 494376 my ($self, $elem, $document) = @_;
49             ### RequireFinalSemicolon elem: $elem->content
50              
51 98 100       267 if (_block_is_hash_constructor($elem) != 0) {
52             ### hash constructor, or likely so, stop ...
53 10         31 return;
54             }
55              
56 88   100     301 my $block_last = $elem->schild(-1)
57             || return; # empty block doesn't need a semi
58              
59             ### block_last: ref($block_last),$block_last->content
60 82 50       1488 $block_last->isa('PPI::Statement') || do {
61             ### last in block is not a PPI-Statement ...
62 0         0 return;
63             };
64 82 100       196 if (_elem_statement_no_need_semicolon($block_last)) {
65 11         43 return;
66             }
67              
68             {
69 71   50     1575 my $bstat_last = $block_last->schild(-1)
  71         189  
70             || return; # statement shouldn't be empty, should it?
71             ### bstat_last in statement: ref($bstat_last),$bstat_last->content
72              
73 71 100       950 if (_elem_is_semicolon($bstat_last)) {
74             ### has final semicolon, ok ...
75 10         165 return;
76             }
77             }
78              
79 61 50       316 if ($self->{'_except_expression_blocks'}) {
80 61 100       154 if (_block_is_expression($elem)) {
81             ### do expression, ok
82 13         97 return;
83             }
84             ### not a do{} expression
85             }
86              
87             # if don't have final brace then this option doesn't apply as there's no
88             # final brace to be on the same line
89 48 100 66     377 if ($self->{'_except_same_line'} && $elem->complete) {
90 46 100       383 if (! _newline_in_following_sibling($block_last)) {
91             ### no newline before close, ok
92 25         75 return;
93             }
94             }
95              
96 23   66     78 my $report_at = $block_last->next_sibling || $block_last;
97 23         466 return $self->violation
98             ('Put semicolon ; on last statement in a block',
99             '',
100             $report_at);
101             }
102              
103             # return true if $elem is a PPI::Statement subclass which doesn't require a
104             # terminating ";"
105             sub _elem_statement_no_need_semicolon {
106 82     82   174 my ($elem) = @_;
107 82   66     1679 return ($elem->isa('PPI::Statement::Compound') # for(){} etc
108             || $elem->isa('PPI::Statement::Sub') # nested named sub
109             || $elem->isa('PPI::Statement::Given')
110             || $elem->isa('PPI::Statement::When')
111             || $elem->isa('PPI::Statement::End') # __END__
112             || $elem->isa('PPI::Statement::Null') # ;
113             || $elem->isa('PPI::Statement::UnmatchedBrace') # stray }
114             || _elem_is_try_block($elem)
115             );
116             }
117              
118             my %postfix_loops = (while => 1, until => 1);
119              
120             my %prefix_expressions = (do => 1,
121             map => 1,
122             grep => 1,
123             sort => 1,
124              
125             map { $_ => 1, "List::Util::$_" => 1 }
126             qw(
127             reduce any all none notall first
128             pairfirst pairgrep pairmap
129             ),
130              
131             map { $_ => 1, "List::Pairwise::$_" => 1 }
132             qw(
133             mapp map_pairwise grepp grep_pairwise
134             firstp first_pairwise lastp last_pairwise
135             ),
136             );
137              
138             # $elem is a PPI::Structure::Block.
139             # return 1 definitely a hash
140             # 0 definitely a block
141             # -1 not certain
142             #
143             # PPI 1.212 tends to be give PPI::Structure::Block for various things which
144             # are actually anon hash constructors and ought to be
145             # PPI::Structure::Constructor. For example,
146             #
147             # return bless { x => 123 };
148             # return \ { x => 123 };
149             #
150             # _block_is_hash_constructor() tries to recognise some of those blocks which
151             # are actually hash constructors, so as not to apply the final semicolon
152             # rule to hash constructors.
153             #
154             my %word_is_block = (sub => 1,
155             do => 1,
156             map => 1,
157             grep => 1,
158             sort => 1,
159              
160             # from Try.pm, TryCatch.pm, Try::Tiny prototypes, etc
161             try => 1,
162             catch => 1,
163             finally => 1,
164              
165             # List::Util first() etc are not of interest to
166             # RequireFinalSemicolon but ProhibitDuplicateHashKeys
167             # shares this code so recognise them for it.
168             %prefix_expressions,
169             );
170             sub _block_is_hash_constructor {
171 109     109   257 my ($elem) = @_;
172             ### _block_is_hash_constructor(): ref($elem), "$elem"
173              
174             # if (_block_starts_semi($elem)) {
175             # ### begins with ";", block is correct ...
176             # return 0;
177             # }
178 109 100       305 if (_block_has_multiple_statements($elem)) {
179             ### contains one or more ";", block is correct ...
180 7         26 return 0;
181             }
182              
183 102 100       414 if (my $prev = $elem->sprevious_sibling) {
184             ### prev: ref($prev), "$prev"
185 95 100       3199 if ($prev->isa('PPI::Structure::Condition')) {
186             ### prev condition, block is correct ...
187 6         19 return 0;
188             }
189 89 100       343 if ($prev->isa('PPI::Token::Cast')) {
190 9 100       33 if ($prev eq '\\') {
191             ### ref cast, is a hash ...
192 8         156 return 1;
193             } else {
194             ### other cast, block is correct (or a variable name) ...
195 1         19 return 0;
196             }
197             }
198 80 50       311 if ($prev->isa('PPI::Token::Operator')) {
199             ### prev operator, is a hash ...
200 0         0 return 1;
201             }
202 80 100       299 if (! $prev->isa('PPI::Token::Word')) {
203             ### prev not a word, not sure ...
204 2         14 return -1;
205             }
206              
207 78 100       227 if ($word_is_block{$prev}) {
208             # "sub { ... }"
209             # "do { ... }"
210             ### do/sub/map/grep/sort, block is correct ...
211 49         357 return 0;
212             }
213              
214 29 100       200 if (! ($prev = $prev->sprevious_sibling)) {
215             # "bless { ... }"
216             # "return { ... }" etc
217             # ENHANCE-ME: notice List::Util first{} and other prototyped things
218             ### nothing else preceding, likely a hash ...
219 3         58 return -1;
220             }
221             ### prev prev: "$prev"
222              
223 26 100       642 if ($prev eq 'sub') {
224             # "sub foo {}"
225             ### named sub, block is correct ...
226 25         433 return 0;
227             }
228             # "word bless { ... }"
229             # "word return { ... }" etc
230             ### other word preceding, likely a hash ...
231 1         53 return -1;
232             }
233              
234 7   33     214 my $parent = $elem->parent || do {
235             ### umm, at toplevel, is a block ...
236             return 0;
237             };
238              
239 7 100 66     120 if ($parent->isa('PPI::Statement::Compound')
      66        
      100        
240             && ($parent = $parent->parent)
241             && (
242             $parent->isa('PPI::Structure::List')
243             ||
244             $parent->isa('PPI::Structure::Constructor'))) {
245             ### in a list or arrayref, is a hashref ...
246              
247             # This catches
248             # ppidump "[{%args}]"
249             # which comes out (from PPI 1.270) as
250             #
251             # PPI::Structure::Constructor [ ... ]
252             # PPI::Statement::Compound
253             # PPI::Structure::Block { ... }
254             # PPI::Statement
255             # PPI::Token::Symbol '%args'
256             #
257             # It should be like
258             #
259             # PPI::Structure::Constructor [ ... ]
260             # PPI::Statement
261             # PPI::Structure::Constructor { ... }
262             # PPI::Statement::Expression
263             #
264             # which is what ppidump "[{x=>1}]" gives.
265             #
266             # The PPI::Structure::List is for something like
267             # ppidump "func({ %args })"
268             # which in for example PPI 1.220 was PPI::Structure::Block too.
269             # That one is ok in PPI 1.270 (when ready to demand that version).
270             #
271             # The plan would be to remove the whole of this check for
272             # PPI::Statement::Compound if PPI can do the right thing on arrayrefs
273             # too ...
274              
275 2         38 return 1;
276             }
277              
278 5         94 return 0;
279             }
280              
281             # $elem is a PPI::Structure::Block
282             # return true if it contains two or more PPI::Statement
283             #
284             sub _block_has_multiple_statements {
285 109     109   194 my ($elem) = @_;
286 109         188 my $count = 0;
287 109         315 foreach my $child ($elem->schildren) {
288 108         1257 $count++;
289 108 100       328 if ($count >= 2) { return 1; }
  7         25  
290             }
291 102         323 return 0;
292             }
293              
294             # $elem is a PPI::Structure::Block
295             # return true if it starts with a ";"
296             #
297             sub _block_starts_semi {
298 0     0   0 my ($elem) = @_;
299              
300             # note child() not schild() since an initial ";" is not "significant"
301 0         0 $elem = $elem->child(0);
302             ### first child: $elem && (ref $elem)." $elem"
303              
304 0         0 $elem = _elem_skip_whitespace_and_comments($elem);
305 0   0     0 return ($elem && $elem->isa('PPI::Statement::Null'));
306             }
307              
308             # $elem is a PPI::Element or undef
309             # return the next non-whitespace and non-comment after it
310             sub _elem_skip_whitespace_and_comments {
311 0     0   0 my ($elem) = @_;
312 0   0     0 while ($elem
      0        
313             && ($elem->isa('PPI::Token::Whitespace')
314             || $elem->isa ('PPI::Token::Comment'))) {
315 0         0 $elem = $elem->next_sibling;
316             ### next elem: $elem && (ref $elem)." $elem"
317             }
318 0         0 return $elem;
319             }
320              
321             sub _elem_is_semicolon {
322 71     71   149 my ($elem) = @_;
323 71   66     321 return ($elem->isa('PPI::Token::Structure') && $elem eq ';');
324             }
325              
326             # $elem is a PPI::Node
327             # return true if any following sibling (not $elem itself) contains a newline
328             sub _newline_in_following_sibling {
329 46     46   107 my ($elem) = @_;
330 46         149 while ($elem = $elem->next_sibling) {
331 52 100       1203 if ($elem =~ /\n/) {
332 21         172 return 1;
333             }
334             }
335 25         596 return 0;
336             }
337              
338             # $block is a PPI::Structure::Block
339             # return true if it's "do{}" expression, and not a "do{}while" or "do{}until"
340             # loop
341             sub _block_is_expression {
342 61     61   127 my ($elem) = @_;
343             ### _block_is_expression(): "$elem"
344              
345 61 100       232 if (my $next = $elem->snext_sibling) {
346 25 100 100     755 if ($next->isa('PPI::Token::Word')
347             && $postfix_loops{$next}) {
348             ### {}while or {}until, not an expression
349 6         47 return 0;
350             }
351             }
352              
353             ### do, map, grep, sort, etc are expressions ..
354 55         1017 my $prev = $elem->sprevious_sibling;
355             return ($prev
356             && $prev->isa('PPI::Token::Word')
357 55   66     1500 && $prefix_expressions{$prev});
358             }
359              
360             # Return true if $elem is a "try" block like
361             # Try.pm try { } catch {}
362             # TryCatch.pm try { } catch ($err) {} ... catch {}
363             # Syntax::Feature::Try try { } catch ($err) {} ... catch {} finally {}
364             # The return is true only for the block type "try"s of these three modules.
365             # "try" forms from Try::Tiny and its friends are plain subroutine calls
366             # rather than blocks.
367             #
368             sub _elem_is_try_block {
369 119     119   574 my ($elem) = @_;
370 119   100     508 return ($elem->isa('PPI::Statement')
371             && ($elem = $elem->schild(0))
372             && $elem->isa('PPI::Token::Word')
373             && $elem->content eq 'try'
374             && _elem_has_preceding_use_trycatch($elem));
375             }
376              
377             # return true if $elem is preceded by any of
378             # use Try
379             # use TryCatch
380             # use syntax 'try'
381             sub _elem_has_preceding_use_trycatch {
382 16     16   371 my ($elem) = @_;
383 16         34 my $ret = 0;
384 16         66 my $document = $elem->top; # PPI::Document, not Perl::Critic::Document
385             $document->find_first (sub {
386 674     674   7630 my ($doc, $e) = @_;
387             # ### comment: (ref $e)." ".$e->content
388 674 100       1397 if ($e == $elem) {
389             ### not found before target elem, stop ...
390 16         96 return undef;
391             }
392 658 100       3229 if (_elem_is_use_try($e)) {
393             ### found "use Try" etc, stop ...
394 11         26 $ret = 1;
395 11         32 return undef;
396             }
397 647         1512 return 0; # continue
398 16         366 });
399 16         284 return $ret;
400             }
401              
402             sub _elem_is_use_try {
403 658     658   1125 my ($elem) = @_;
404 658 100 66     2418 ($elem->isa('PPI::Statement::Include') && $elem->type eq 'use')
405             or return 0;
406 16         400 my $module = $elem->module;
407 16   66     468 return ($module eq 'Try'
408             || $module eq 'TryCatch'
409             || ($module eq 'syntax'
410             && _syntax_has_feature($elem,'try')));
411             }
412              
413             # $elem is a PPI::Statement::Include of "use syntax".
414             # Return true if $feature (a string) is among the feature names it imports.
415             sub _syntax_has_feature {
416 6     6   12362 my ($elem, $feature) = @_;
417 6         26 return ((grep {$_ eq $feature} _syntax_feature_list($elem)) > 0);
  11         40  
418             }
419              
420             # $elem is a PPI::Statement::Include of "use syntax".
421             # Return a list of the feature names it imports.
422             sub _syntax_feature_list {
423 9     9   517382 my ($elem) = @_;
424             ### _syntax_feature_list(): $elem && ref $elem
425 9         22 my @ret;
426 9         38 for ($elem = $elem->schild(2); $elem; $elem = $elem->snext_sibling) {
427 33 100       1380 if ($elem->isa('PPI::Token::Word')) {
    100          
    100          
428 5         17 push @ret, $elem->content;
429             } elsif ($elem->isa('PPI::Token::QuoteLike::Words')) {
430 3         14 push @ret, $elem->literal;
431             } elsif ($elem->isa('PPI::Token::Quote')) {
432 5         34 push @ret, $elem->string;
433             }
434             }
435 9         343 return @ret;
436             }
437              
438             1;
439             __END__
440              
441             =for stopwords boolean hashref eg Ryde
442              
443             =head1 NAME
444              
445             Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon - require a semicolon at the end of code blocks
446              
447             =head1 DESCRIPTION
448              
449             This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
450             add-on. It asks you to put a semicolon C<;> on the final statement of a
451             subroutine or block.
452              
453             sub foo {
454             do_something(); # ok
455             }
456              
457             sub bar {
458             do_something() # bad
459             }
460              
461             The idea is that if you add more code you don't have to notice the previous
462             line needs a terminator. It's also more like the C language, if you
463             consider that a virtue.
464              
465             This is only a matter of style since the code runs the same either way, and
466             on that basis this policy is low severity and under the "cosmetic" theme
467             (see L<Perl::Critic/POLICY THEMES>).
468              
469             =head2 Same Line Closing Brace
470              
471             By default (see L</CONFIGURATION> below), a semicolon is not required when
472             the closing brace is on the same line as the last statement. This is good
473             for constants and one-liners.
474              
475             sub foo { 'my-constant-value' } # ok
476              
477             sub square { return $_[0] ** 2 } # ok
478              
479             =head2 Final Value Expression
480              
481             A semicolon is not required in places where the last statement is an
482             expression giving a value.
483              
484             map { some_thing();
485             $_+123 # ok
486             } @values;
487              
488             do {
489             foo();
490             1+2+3 # ok
491             }
492              
493             This currently means
494              
495             do grep map sort # builtins
496              
497             reduce any all none notall first # List::Util
498             pairfirst pairgrep pairmap
499              
500             mapp map_pairwise grepp grep_pairwise # List::Pairwise
501             firstp first_pairwise lastp last_pairwise
502              
503             These module function names are always treated as expressions. There's no
504             check for whether the respective module is actually in use. Fully qualified
505             names like C<List::Util::first> are recognised too.
506              
507             C<do {} while> or C<do {} until> loops are ordinary blocks, not expression
508             blocks, so still require a semicolon on the last statement inside.
509              
510             do {
511             foo() # bad
512             } until ($condition);
513              
514             =head2 Try/Catch Blocks
515              
516             The C<Try>, C<TryCatch> and C<Syntax::Feature::Try> modules all add C<try>
517             block forms. These are blocks not requiring a terminating semicolon, the
518             same as an C<if> etc doesn't.
519              
520             use TryCatch;
521             sub foo {
522             try {
523             attempt_something();
524             } catch {
525             error_recovery();
526             } # ok, no semi required here for TryCatch
527             }
528              
529             The insides of the C<try> and C<catch> are the same as other blocks, but the
530             C<try> statement itself doesn't require a semicolon. (See policy
531             C<ValuesAndExpressions::ProhibitNullStatements> to notice one added
532             unnecessarily.)
533              
534             For reference, C<PPI> doesn't know C<try>/C<catch> specifically, so when
535             they don't have a final semicolon the next statement runs together and the
536             nature of those parts might be lost. This could upset things like
537             recognition of C<for> loops and could potentially make some perlcritic
538             reports go wrong.
539              
540             The C<try>/C<catch> block exemption here is only for the modules with this
541             block syntax. There are other try modules such as C<Try::Tiny> and friends
542             where a final semicolon is normal and necessary if more code follows
543             (because their C<try> and C<catch> are ordinary function calls prototyped to
544             take code blocks).
545              
546             use Try::Tiny;
547             sub foo {
548             try {
549             attempt_something();
550             } catch {
551             error_recovery();
552             } # bad, semi required here for Try::Tiny
553             }
554              
555             =head2 Disabling
556              
557             If you don't care about this you can always disable from your
558             F<.perlcriticrc> file in the usual way (see L<Perl::Critic/CONFIGURATION>),
559              
560             [-CodeLayout::RequireFinalSemicolon]
561              
562             =head1 CONFIGURATION
563              
564             =over 4
565              
566             =item C<except_same_line> (boolean, default true)
567              
568             If true (the default) then don't demand a semicolon if the closing brace is
569             on the same line as the final statement.
570              
571             sub foo { return 123 } # ok if "except_same_line=yes"
572             # bad if "except_same_line=no"
573              
574             =item C<except_expression_blocks> (boolean, default true)
575              
576             If true (the default) then don't demand a semicolon at the end of an
577             expression block, as described under L</Final Value Expression> above.
578              
579             # ok under "except_expression_blocks=yes"
580             # bad under "except_expression_blocks=no"
581             do { 1+2+3 }
582             map { $_+1 } @array
583             grep {defined} @x
584              
585             The statements and functions for this exception are currently hard coded.
586             Maybe in the future they could be configurable, though multi-line
587             expressions in this sort of thing tends to be unusual anyway. (See policy
588             C<BuiltinFunctions::RequireSimpleSortBlock> for example to demand C<sort> is
589             only one line.)
590              
591             =back
592              
593             =head1 BUGS
594              
595             It's very difficult to distinguish a code block from an anonymous hashref
596             constructor if there might be a function prototype in force, eg.
597              
598             foo { abc => 123 }; # hash ref normally
599             # code block if foo() has prototype
600              
601             C<PPI> tends to assume code. C<RequireFinalSemicolon> currently assumes
602             hashref so as to avoid false violations. Any C<try>, C<catch> or C<finally>
603             are presumed to be code blocks (the various Try modules). Perhaps other
604             common or particular functions or syntax with code blocks could be
605             recognised. In general this sort of ambiguity is another good reason to
606             avoid function prototypes.
607              
608             PPI as of its version 1.270 sometimes takes hashrefs in lists and arrarefs
609             to be code blocks, eg.
610              
611             ppidump 'foo({%y,x=>1})'
612             ppidump '[{%y,x=>1}]'
613              
614             ppidump '[{x=>1,%y}]' # ok, hash
615              
616              
617             =head1 SEE ALSO
618              
619             L<Perl::Critic::Pulp>,
620             L<Perl::Critic>,
621             L<Perl::Critic::Policy::CodeLayout::RequireTrailingCommas>,
622             L<Perl::Critic::Policy::CodeLayout::RequireTrailingCommaAtNewline>,
623             L<Perl::Critic::Policy::Subroutines::RequireFinalReturn>,
624             L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitNullStatements>,
625             L<Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock>
626              
627             L<List::Util>, L<List::Pairwise>,
628             L<Try>, L<TryCatch>, L<Syntax::Feature::Try>
629              
630             =head1 HOME PAGE
631              
632             L<http://user42.tuxfamily.org/perl-critic-pulp/index.html>
633              
634             =head1 COPYRIGHT
635              
636             Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde
637              
638             Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
639             under the terms of the GNU General Public License as published by the Free
640             Software Foundation; either version 3, or (at your option) any later
641             version.
642              
643             Perl-Critic-Pulp is distributed in the hope that it will be useful, but
644             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
645             or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
646             more details.
647              
648             You should have received a copy of the GNU General Public License along with
649             Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses>.
650              
651             =cut