File Coverage

blib/lib/Perl/Critic/Policy/ControlStructures/ProhibitUnreachableCode.pm
Criterion Covered Total %
statement 43 43 100.0
branch 23 24 95.8
condition 16 18 88.8
subroutine 12 12 100.0
pod 4 5 80.0
total 98 102 96.0


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode;
2              
3 40     40   27215 use 5.010001;
  40         184  
4 40     40   250 use strict;
  40         119  
  40         905  
5 40     40   226 use warnings;
  40         127  
  40         1024  
6 40     40   260 use Readonly;
  40         123  
  40         2200  
7              
8 40     40   305 use Perl::Critic::Utils qw{ :severities :data_conversion :classification };
  40         102  
  40         2138  
9 40     40   16193 use parent 'Perl::Critic::Policy';
  40         151  
  40         278  
10              
11             our $VERSION = '1.146';
12              
13             Readonly::Array my @TERMINALS => qw( die exit croak confess );
14             Readonly::Hash my %TERMINALS => hashify( @TERMINALS );
15              
16             Readonly::Array my @CONDITIONALS => qw( if unless foreach while until for );
17             Readonly::Hash my %CONDITIONALS => hashify( @CONDITIONALS );
18              
19             Readonly::Array my @OPERATORS => qw( && || // and or err ? );
20             Readonly::Hash my %OPERATORS => hashify( @OPERATORS );
21              
22             #-----------------------------------------------------------------------------
23              
24             Readonly::Scalar my $DESC => q{Unreachable code};
25             Readonly::Scalar my $EXPL => q{Consider removing it};
26              
27             #-----------------------------------------------------------------------------
28              
29 98     98 0 1659 sub supported_parameters { return () }
30 86     86 1 377 sub default_severity { return $SEVERITY_HIGH }
31 74     74 1 356 sub default_themes { return qw( core bugs certrec ) }
32 41     41 1 140 sub applies_to { return 'PPI::Token::Word' }
33              
34             #-----------------------------------------------------------------------------
35              
36             sub violates {
37 451     451 1 943 my ( $self, $elem, undef ) = @_;
38              
39 451         1087 my $statement = $elem->statement();
40 451 50       6420 return if not $statement;
41              
42             # We check to see if this is an interesting token before calling
43             # is_function_call(). This weeds out most candidate tokens and
44             # prevents us from having to make an expensive function call.
45              
46 451 100 100     1018 return if ( !exists $TERMINALS{$elem} ) &&
47             ( !$statement->isa('PPI::Statement::Break') );
48              
49 43 100       677 return if not is_function_call($elem);
50              
51             # Scan the enclosing statement for conditional keywords or logical
52             # operators. If any are found, then this the following statements
53             # could _potentially_ be executed, so this policy is satisfied.
54              
55             # NOTE: When the first operand in an boolean expression is
56             # C<croak> or C<die>, etc., the second operand is technically
57             # unreachable. But this policy doesn't catch that situation.
58              
59 38         156 for my $child ( $statement->schildren() ) {
60 96 100 100     1257 return if $child->isa('PPI::Token::Operator') && exists $OPERATORS{$child};
61 94 100 100     416 return if $child->isa('PPI::Token::Word') && exists $CONDITIONALS{$child};
62             }
63              
64 28         105 return $self->_gather_violations($statement);
65             }
66              
67             sub _gather_violations {
68 28     28   68 my ($self, $statement) = @_;
69              
70             # If we get here, then the statement contained an unconditional
71             # die or exit or return. Then all the subsequent sibling
72             # statements are unreachable, except for those that have labels,
73             # which could be reached from anywhere using C<goto>. Subroutine
74             # declarations are also exempt for the same reason. "use" and
75             # "our" statements are exempt because they happen at compile time.
76              
77 28         55 my @violations = ();
78 28         94 while ( $statement = $statement->snext_sibling() ) {
79 27         874 my @children = $statement->schildren();
80 27 100 66     376 last if @children && $children[0]->isa('PPI::Token::Label');
81 22 100       106 next if $statement->isa('PPI::Statement::Sub');
82 18 100       72 next if $statement->isa('PPI::Statement::End');
83 17 100       66 next if $statement->isa('PPI::Statement::Data');
84 16 100       56 next if $statement->isa('PPI::Statement::Package');
85              
86 15 100 100     64 next if $statement->isa('PPI::Statement::Include') &&
87             $statement->type() ne 'require';
88              
89 13 100 66     88 next if $statement->isa('PPI::Statement::Variable') &&
90             $statement->type() eq 'our';
91              
92 12         47 push @violations, $self->violation( $DESC, $EXPL, $statement );
93             }
94              
95 28         807 return @violations;
96             }
97              
98             1;
99              
100             __END__
101              
102             =pod
103              
104             =head1 NAME
105              
106             Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode - Don't write code after an unconditional C<die, exit, or next>.
107              
108             =head1 AFFILIATION
109              
110             This Policy is part of the core L<Perl::Critic|Perl::Critic>
111             distribution.
112              
113              
114             =head1 DESCRIPTION
115              
116             This policy prohibits code following a statement which unconditionally
117             alters the program flow. This includes calls to C<exit>, C<die>,
118             C<return>, C<next>, C<last> and C<goto>. Due to common usage,
119             C<croak> and C<confess> from L<Carp|Carp> are also included.
120              
121             Code is reachable if any of the following conditions are true:
122              
123             =over
124              
125             =item * Flow-altering statement has a conditional attached to it
126              
127             =item * Statement is on the right side of an operator C<&&>, C<||>, C<//>, C<and>, C<or>, or C<err>.
128              
129             =item * Code is prefixed with a label (can potentially be reached via C<goto>)
130              
131             =item * Code is a subroutine
132              
133             =back
134              
135             =head1 EXAMPLES
136              
137             # not ok
138              
139             exit;
140             print "123\n";
141              
142             # ok
143              
144             exit if !$xyz;
145             print "123\n";
146              
147             # not ok
148              
149             for ( 1 .. 10 ) {
150             next;
151             print 1;
152             }
153              
154             # ok
155              
156             for ( 1 .. 10 ) {
157             next if $_ == 5;
158             print 1;
159             }
160              
161             # not ok
162              
163             sub foo {
164             my $bar = shift;
165             return;
166             print 1;
167             }
168              
169             # ok
170              
171             sub foo {
172             my $bar = shift;
173             return if $bar->baz();
174             print 1;
175             }
176              
177              
178             # not ok
179              
180             die;
181             print "123\n";
182              
183             # ok
184              
185             die;
186             LABEL: print "123\n";
187              
188             # not ok
189              
190             croak;
191             do_something();
192              
193             # ok
194              
195             croak;
196             sub do_something {}
197              
198              
199             =head1 CONFIGURATION
200              
201             This Policy is not configurable except for the standard options.
202              
203              
204             =head1 SEE ALSO
205              
206             L<Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls|Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls>
207              
208             =head1 AUTHOR
209              
210             Peter Guzis <pguzis@cpan.org>
211              
212             =head1 COPYRIGHT
213              
214             Copyright (c) 2006-2011 Peter Guzis. All rights reserved.
215              
216             This program is free software; you can redistribute it and/or modify
217             it under the same terms as Perl itself. The full text of this license
218             can be found in the LICENSE file included with this module.
219              
220             =cut
221              
222             # Local Variables:
223             # mode: cperl
224             # cperl-indent-level: 4
225             # fill-column: 78
226             # indent-tabs-mode: nil
227             # c-indentation-style: bsd
228             # End:
229             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :