File Coverage

blib/lib/Perl/Critic/Policy/ControlStructures/ProhibitUnreachableCode.pm
Criterion Covered Total %
statement 34 43 79.0
branch 8 24 33.3
condition 5 18 27.7
subroutine 12 12 100.0
pod 4 5 80.0
total 63 102 61.7


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode;
2              
3 40     40   26944 use 5.010001;
  40         188  
4 40     40   286 use strict;
  40         118  
  40         836  
5 40     40   228 use warnings;
  40         102  
  40         944  
6 40     40   219 use Readonly;
  40         100  
  40         1995  
7              
8 40     40   287 use Perl::Critic::Utils qw{ :severities :data_conversion :classification };
  40         134  
  40         2077  
9 40     40   15727 use parent 'Perl::Critic::Policy';
  40         115  
  40         255  
10              
11             our $VERSION = '1.150';
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 89     89 0 1620 sub supported_parameters { return () }
30 74     74 1 323 sub default_severity { return $SEVERITY_HIGH }
31 74     74 1 379 sub default_themes { return qw( core bugs certrec ) }
32 32     32 1 85 sub applies_to { return 'PPI::Token::Word' }
33              
34             #-----------------------------------------------------------------------------
35              
36             sub violates {
37 346     346 1 621 my ( $self, $elem, undef ) = @_;
38              
39 346         655 my $statement = $elem->statement();
40 346 50       4144 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 346 100 66     711 return if ( !exists $TERMINALS{$elem} ) &&
47             ( !$statement->isa('PPI::Statement::Break') );
48              
49 7 100       118 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 a 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 6         49 for my $child ( $statement->schildren() ) {
60 18 50 33     206 return if exists $OPERATORS{$child} && $child->isa('PPI::Token::Operator');
61 18 100 66     199 return if exists $CONDITIONALS{$child} && $child->isa('PPI::Token::Word');
62             }
63              
64 5         55 return $self->_gather_violations($statement);
65             }
66              
67             sub _gather_violations {
68 5     5   13 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 5         9 my @violations;
78 5         14 while ( $statement = $statement->snext_sibling() ) {
79 0         0 my @children = $statement->schildren();
80 0 0 0     0 last if @children && $children[0]->isa('PPI::Token::Label');
81 0 0       0 next if $statement->isa('PPI::Statement::Sub');
82 0 0       0 next if $statement->isa('PPI::Statement::End');
83 0 0       0 next if $statement->isa('PPI::Statement::Data');
84 0 0       0 next if $statement->isa('PPI::Statement::Package');
85              
86 0 0 0     0 next if $statement->isa('PPI::Statement::Include') &&
87             $statement->type() ne 'require';
88              
89 0 0 0     0 next if $statement->isa('PPI::Statement::Variable') &&
90             $statement->type() eq 'our';
91              
92 0         0 push @violations, $self->violation( $DESC, $EXPL, $statement );
93             }
94              
95 5         125 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 :