← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:11 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/Subroutines/RequireFinalReturn.pm
StatementsExecuted 20 statements in 1.02ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11116µs16µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::BEGIN@10Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@10
11114µs16µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::supported_parametersPerl::Critic::Policy::Subroutines::RequireFinalReturn::supported_parameters
1118µs28µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::BEGIN@15Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@15
1118µs12µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::BEGIN@12Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@12
1118µs61µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::BEGIN@17Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@17
1118µs28µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::BEGIN@13Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@13
1117µs425µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::BEGIN@16Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@16
1117µs18µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::BEGIN@11Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@11
1116µs7µsPerl::Critic::Policy::Subroutines::RequireFinalReturn::::default_severityPerl::Critic::Policy::Subroutines::RequireFinalReturn::default_severity
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_block_has_returnPerl::Critic::Policy::Subroutines::RequireFinalReturn::_block_has_return
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_block_is_emptyPerl::Critic::Policy::Subroutines::RequireFinalReturn::_block_is_empty
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_compound_returnPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_compound_return
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_conditional_stmntPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_conditional_stmnt
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_explicit_returnPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_explicit_return
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_given_when_returnPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_given_when_return
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_return_or_goto_stmntPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_return_or_goto_stmnt
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_suffix_when_with_returnPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_suffix_when_with_return
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_terminal_stmntPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_terminal_stmnt
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::_is_when_stmnt_with_returnPerl::Critic::Policy::Subroutines::RequireFinalReturn::_is_when_stmnt_with_return
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::applies_toPerl::Critic::Policy::Subroutines::RequireFinalReturn::applies_to
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::default_themesPerl::Critic::Policy::Subroutines::RequireFinalReturn::default_themes
0000s0sPerl::Critic::Policy::Subroutines::RequireFinalReturn::::violatesPerl::Critic::Policy::Subroutines::RequireFinalReturn::violates
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Policy::Subroutines::RequireFinalReturn;
9
10243µs116µs
# spent 16µs within Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@10 which was called: # once (16µs+0s) by Module::Pluggable::Object::_require at line 10
use 5.006001;
# spent 16µs making 1 call to Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@10
11220µs230µs
# spent 18µs (7+11) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@11 which was called: # once (7µs+11µs) by Module::Pluggable::Object::_require at line 11
use strict;
# spent 18µs making 1 call to Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@11 # spent 11µs making 1 call to strict::import
12218µs215µs
# spent 12µs (8+4) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@12 which was called: # once (8µs+4µs) by Module::Pluggable::Object::_require at line 12
use warnings;
# spent 12µs making 1 call to Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@12 # spent 4µs making 1 call to warnings::import
13222µs248µs
# spent 28µs (8+20) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@13 which was called: # once (8µs+20µs) by Module::Pluggable::Object::_require at line 13
use Readonly;
# spent 28µs making 1 call to Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@13 # spent 20µs making 1 call to Exporter::import
14
15222µs249µs
# spent 28µs (8+20) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@15 which was called: # once (8µs+20µs) by Module::Pluggable::Object::_require at line 15
use Perl::Critic::Exception::Fatal::Internal qw{ throw_internal };
# spent 28µs making 1 call to Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@15 # spent 20µs making 1 call to Exporter::import
16224µs2843µs
# spent 425µs (7+418) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@16 which was called: # once (7µs+418µs) by Module::Pluggable::Object::_require at line 16
use Perl::Critic::Utils qw{ :characters :severities :data_conversion };
# spent 425µs making 1 call to Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@16 # spent 418µs making 1 call to Exporter::import
172844µs2114µs
# spent 61µs (8+53) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@17 which was called: # once (8µs+53µs) by Module::Pluggable::Object::_require at line 17
use base 'Perl::Critic::Policy';
# spent 61µs making 1 call to Perl::Critic::Policy::Subroutines::RequireFinalReturn::BEGIN@17 # spent 53µs making 1 call to base::import
18
191600nsour $VERSION = '1.121';
20
21#-----------------------------------------------------------------------------
22
2312µs150µsReadonly::Scalar my $EXPL => [ 197 ];
# spent 50µs making 1 call to Readonly::Scalar
24
2513µs227µsReadonly::Hash my %CONDITIONALS => hashify( qw(if unless for foreach) );
# spent 24µs making 1 call to Readonly::Hash # spent 3µs making 1 call to Perl::Critic::Utils::hashify
26
27#-----------------------------------------------------------------------------
28
29
# spent 16µs (14+2) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::supported_parameters which was called: # once (14µs+2µs) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters {
30 return (
31 {
32112µs22µs name => 'terminal_funcs',
# spent 2µs making 2 calls to Readonly::Scalar::FETCH, avg 1µs/call
33 description => 'The additional subroutines to treat as terminal.',
34 default_string => $EMPTY,
35 behavior => 'string list',
36 list_always_present_values =>
37 [ qw< croak confess die exec exit throw Carp::confess Carp::croak > ],
38 },
39 );
40}
41
4212µs
# spent 7µs (6+1) within Perl::Critic::Policy::Subroutines::RequireFinalReturn::default_severity which was called: # once (6µs+1µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm
sub default_severity { return $SEVERITY_HIGH }
43sub default_themes { return qw( core bugs pbp certrec ) }
44sub applies_to { return 'PPI::Statement::Sub' }
45
46#-----------------------------------------------------------------------------
47
48sub violates {
49 my ( $self, $elem, undef ) = @_;
50
51 # skip BEGIN{} and INIT{} and END{} etc
52 return if $elem->isa('PPI::Statement::Scheduled');
53
54 my @blocks = grep {$_->isa('PPI::Structure::Block')} $elem->schildren();
55 if (@blocks > 1) {
56 # sanity check
57 throw_internal 'Subroutine should have no more than one block';
58 }
59 elsif (@blocks == 0) {
60 #Technically, subroutines don't have to have a block at all. In
61 # that case, its just a declaration so this policy doesn't really apply
62 return; # ok!
63 }
64
65
66 my ($block) = @blocks;
67 if ($self->_block_is_empty($block) || $self->_block_has_return($block)) {
68 return; # OK
69 }
70
71 # Must be a violation
72 my $desc;
73 if ( my $name = $elem->name() ) {
74 $desc = qq<Subroutine "$name" does not end with "return">;
75 }
76 else {
77 $desc = q<Subroutine does not end with "return">;
78 }
79
80 return $self->violation( $desc, $EXPL, $elem );
81}
82
83#-----------------------------------------------------------------------------
84
85sub _block_is_empty {
86 my ( $self, $block ) = @_;
87 return $block->schildren() == 0;
88}
89
90#-----------------------------------------------------------------------------
91
92sub _block_has_return {
93 my ( $self, $block ) = @_;
94 my @blockparts = $block->schildren();
95 my $final = $blockparts[-1]; # always defined because we call _block_is_empty first
96 return if !$final;
97 return $self->_is_explicit_return($final)
98 || $self->_is_given_when_return($final)
99 || $self->_is_compound_return($final);
100}
101
102#-----------------------------------------------------------------------------
103
104sub _is_explicit_return {
105 my ( $self, $final ) = @_;
106
107 return if $self->_is_conditional_stmnt( $final );
108 return $self->_is_return_or_goto_stmnt( $final )
109 || $self->_is_terminal_stmnt( $final );
110}
111
112#-----------------------------------------------------------------------------
113
114sub _is_compound_return {
115 my ( $self, $final ) = @_;
116
117 if (!$final->isa('PPI::Statement::Compound')) {
118 return; #fail
119 }
120
121 my $begin = $final->schild(0);
122 return if !$begin; #fail
123 if (!($begin->isa('PPI::Token::Word') &&
124 ($begin eq 'if' || $begin eq 'unless'))) {
125 return; #fail
126 }
127
128 my @blocks = grep {!$_->isa('PPI::Structure::Condition') &&
129 !$_->isa('PPI::Token')} $final->schildren();
130 # Sanity check:
131 if (scalar grep {!$_->isa('PPI::Structure::Block')} @blocks) {
132 throw_internal
133 'Expected only conditions, blocks and tokens in the if statement';
134 }
135
136 for my $block (@blocks) {
137 if (! $self->_block_has_return($block)) {
138 return; #fail
139 }
140 }
141
142 return 1;
143}
144
145#-----------------------------------------------------------------------------
146
147sub _is_given_when_return {
148 my ( $self, $final ) = @_;
149
150 if ( ! $final->isa( 'PPI::Statement::Given' ) ) {
151 return; #fail
152 }
153
154 my $begin = $final->schild(0);
155 return if !$begin; #fail
156 if ( ! ( $begin->isa( 'PPI::Token::Word' ) &&
157 $begin->content() eq 'given' ) ) {
158 return; #fail
159 }
160
161 my @blocks = grep {!$_->isa( 'PPI::Structure::Given' ) &&
162 !$_->isa( 'PPI::Token' )} $final->schildren();
163 # Sanity check:
164 if (scalar grep {!$_->isa('PPI::Structure::Block')} @blocks) {
165 throw_internal
166 'Expected only givens, blocks and tokens in the given statement';
167 }
168 if (@blocks > 1) {
169 # sanity check
170 throw_internal 'Given statement should have no more than one block';
171 }
172 @blocks or return; #fail
173
174 my $have_default; # We have to fail unless a default block is present
175
176 foreach my $stmnt ( $blocks[0]->schildren() ) {
177
178 if ( $stmnt->isa( 'PPI::Statement::When' ) ) {
179
180 # Check for the default block.
181 my $first_token;
182 $first_token = $stmnt->schild( 0 )
183 and 'default' eq $first_token->content()
184 and $have_default = 1;
185
186 $self->_is_when_stmnt_with_return( $stmnt )
187 or return; #fail
188
189 } else {
190
191 $self->_is_suffix_when_with_return( $stmnt )
192 or return; #fail
193
194 }
195
196 }
197
198 return $have_default;
199}
200
201#-----------------------------------------------------------------------------
202
203sub _is_return_or_goto_stmnt {
204 my ( $self, $stmnt ) = @_;
205 return if not $stmnt->isa('PPI::Statement::Break');
206 my $first_token = $stmnt->schild(0) || return;
207 return $first_token eq 'return' || $first_token eq 'goto';
208}
209
210#-----------------------------------------------------------------------------
211
212sub _is_terminal_stmnt {
213 my ( $self, $stmnt ) = @_;
214 return if not $stmnt->isa('PPI::Statement');
215 my $first_token = $stmnt->schild(0) || return;
216 return exists $self->{_terminal_funcs}->{$first_token};
217}
218
219#-----------------------------------------------------------------------------
220
221sub _is_conditional_stmnt {
222 my ( $self, $stmnt ) = @_;
223 return if not $stmnt->isa('PPI::Statement');
224 for my $elem ( $stmnt->schildren() ) {
225 return 1 if $elem->isa('PPI::Token::Word')
226 && exists $CONDITIONALS{$elem};
227 }
228 return;
229}
230
231#-----------------------------------------------------------------------------
232
233sub _is_when_stmnt_with_return {
234 my ( $self, $stmnt ) = @_;
235
236 my @inner = grep { ! $_->isa( 'PPI::Token' ) &&
237 ! $_->isa( 'PPI::Structure::When' ) }
238 $stmnt->schildren();
239 if ( scalar grep { ! $_->isa( 'PPI::Structure::Block' ) } @inner ) {
240 throw_internal 'When statement should contain only tokens, conditions, and blocks';
241 }
242 @inner > 1
243 and throw_internal 'When statement should have no more than one block';
244 @inner or return; #fail
245
246 foreach my $block ( @inner ) {
247 if ( ! $self->_block_has_return( $block ) ) {
248 return; #fail
249 }
250 }
251
252 return 1; #succeed
253}
254
255#-----------------------------------------------------------------------------
256
257sub _is_suffix_when_with_return {
258 my ( $self, $stmnt ) = @_;
259 return if not $stmnt->isa('PPI::Statement');
260 foreach my $elem ( $stmnt->schildren() ) {
261 return ( $self->_is_return_or_goto_stmnt( $stmnt ) ||
262 $self->_is_terminal_stmnt( $stmnt ) )
263 if $elem->isa( 'PPI::Token::Word' )
264 && 'when' eq $elem->content();
265 }
266 return;
267}
268
26914µs1;
270
271__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.