← 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:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/ErrorHandling/RequireCheckingReturnValueOfEval.pm
StatementsExecuted 24 statements in 1.15ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11117µs17µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::BEGIN@10Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@10
11111µs32µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::BEGIN@14Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@14
1119µs11µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::default_severityPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::default_severity
1118µs29µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::BEGIN@16Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@16
1118µs12µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::BEGIN@12Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@12
1117µs19µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::BEGIN@11Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@11
1117µs57µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::BEGIN@20Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@20
1117µs399µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::BEGIN@18Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@18
1112µs2µsPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::supported_parametersPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::supported_parameters
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_descendant_ofPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_descendant_of
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_grandparent_for_is_in_right_hand_side_of_assignmentPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_grandparent_for_is_in_right_hand_side_of_assignment
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_is_effectively_a_commaPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_effectively_a_comma
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_is_in_correct_position_in_a_condition_or_foreach_loop_collectionPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_correct_position_in_a_condition_or_foreach_loop_collection
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_is_in_correct_position_in_a_structure_conditionPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_correct_position_in_a_structure_condition
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_is_in_postfix_expressionPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_postfix_expression
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_is_in_right_hand_side_of_assignmentPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_right_hand_side_of_assignment
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::_scan_backwards_for_grepPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_scan_backwards_for_grep
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::applies_toPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::applies_to
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::default_themesPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::default_themes
0000s0sPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::::violatesPerl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::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::ErrorHandling::RequireCheckingReturnValueOfEval;
9
10240µs117µs
# spent 17µs within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@10 which was called: # once (17µs+0s) by Module::Pluggable::Object::_require at line 10
use 5.006001;
11220µs230µs
# spent 19µs (7+11) within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@11 which was called: # once (7µs+11µs) by Module::Pluggable::Object::_require at line 11
use strict;
# spent 19µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@11 # spent 11µs making 1 call to strict::import
12219µs215µs
# spent 12µs (8+4) within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@12 which was called: # once (8µs+4µs) by Module::Pluggable::Object::_require at line 12
use warnings;
13
14223µs253µs
# spent 32µs (11+21) within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@14 which was called: # once (11µs+21µs) by Module::Pluggable::Object::_require at line 14
use Readonly;
15
16224µs250µs
# spent 29µs (8+21) within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@16 which was called: # once (8µs+21µs) by Module::Pluggable::Object::_require at line 16
use Scalar::Util qw< refaddr >;
17
181200ns
# spent 399µs (7+392) within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@18 which was called: # once (7µs+392µs) by Module::Pluggable::Object::_require at line 19
use Perl::Critic::Utils qw< :booleans :characters :severities hashify
19124µs2792µs precedence_of >;
# spent 399µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@18 # spent 392µs making 1 call to Exporter::import
202971µs2107µs
# spent 57µs (7+50) within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@20 which was called: # once (7µs+50µs) by Module::Pluggable::Object::_require at line 20
use base 'Perl::Critic::Policy';
# spent 57µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@20 # spent 50µs making 1 call to base::import
21
221700nsour $VERSION = '1.121';
23
24#-----------------------------------------------------------------------------
25
2612µs132µsReadonly::Scalar my $DESC => 'Return value of eval not tested.';
# spent 32µs making 1 call to Readonly::Scalar
27## no critic (RequireInterpolationOfMetachars)
2811µs123µsReadonly::Scalar my $EXPL =>
# spent 23µs making 1 call to Readonly::Scalar
29 q<You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed.>;
30## use critic
31
3213µs232µsReadonly::Hash my %BOOLEAN_OPERATORS => hashify qw< || && // or and >;
# spent 28µs making 1 call to Readonly::Hash # spent 3µs making 1 call to Perl::Critic::Utils::hashify
3313µs230µsReadonly::Hash my %POSTFIX_OPERATORS =>
# spent 26µs making 1 call to Readonly::Hash # spent 3µs making 1 call to Perl::Critic::Utils::hashify
34 hashify qw< for foreach if unless while until >;
35
3613µs243µsReadonly::Scalar my $PRECEDENCE_OF_EQUALS => precedence_of( q{=} );
# spent 34µs making 1 call to Readonly::Scalar # spent 9µs making 1 call to Perl::Critic::Utils::precedence_of
37
38#-----------------------------------------------------------------------------
39
4014µs
# spent 2µs within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::supported_parameters which was called: # once (2µs+0s) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters { return () }
4112µs
# spent 11µs (9+2) within Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::default_severity which was called: # once (9µs+2µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm
sub default_severity { return $SEVERITY_MEDIUM }
42sub default_themes { return qw( core bugs ) }
43sub applies_to { return 'PPI::Token::Word' }
44
45#-----------------------------------------------------------------------------
46
47sub violates {
48 my ( $self, $elem, undef ) = @_;
49
50 return if $elem->content() ne 'eval';
51
52 my $evaluated = $elem->snext_sibling() or return; # Nothing to eval!
53 my $following = $evaluated->snext_sibling();
54
55 return if _is_in_right_hand_side_of_assignment($elem);
56 return if _is_in_postfix_expression($elem);
57 return if
58 _is_in_correct_position_in_a_condition_or_foreach_loop_collection(
59 $elem,
60 $following,
61 );
62
63 return if _scan_backwards_for_grep( $elem ); # RT 69489
64
65 if ( $following and $following->isa('PPI::Token::Operator') ) {
66 return if $BOOLEAN_OPERATORS{ $following->content() };
67 return if q{?} eq $following->content;
68 }
69
70 return $self->violation($DESC, $EXPL, $elem);
71}
72
73#-----------------------------------------------------------------------------
74
75sub _is_in_right_hand_side_of_assignment {
76 my ($elem) = @_;
77
78 my $previous = $elem->sprevious_sibling();
79
80 if (not $previous) {
81 $previous =
82 _grandparent_for_is_in_right_hand_side_of_assignment($elem);
83 }
84
85 while ($previous) {
86 my $base_previous = $previous;
87
88 EQUALS_SCAN:
89 while ($previous) {
90 if ( $previous->isa('PPI::Token::Operator') ) {
91 return $TRUE if $previous->content() eq q<=>;
92 last EQUALS_SCAN if _is_effectively_a_comma($previous);
93 }
94 $previous = $previous->sprevious_sibling();
95 }
96
97 $previous =
98 _grandparent_for_is_in_right_hand_side_of_assignment($base_previous);
99 }
100
101 return;
102}
103
104sub _grandparent_for_is_in_right_hand_side_of_assignment {
105 my ($elem) = @_;
106
107 my $parent = $elem->parent() or return;
108 $parent->isa('PPI::Statement') or return;
109
110 my $grandparent = $parent->parent() or return;
111
112 if (
113 $grandparent->isa('PPI::Structure::Constructor')
114 or $grandparent->isa('PPI::Structure::List')
115 ) {
116 return $grandparent;
117 }
118
119 return;
120}
121
122#-----------------------------------------------------------------------------
123
12411µs123µsReadonly::Scalar my $CONDITION_POSITION_IN_C_STYLE_FOR_LOOP => 1;
# spent 23µs making 1 call to Readonly::Scalar
125
126sub _is_in_correct_position_in_a_condition_or_foreach_loop_collection {
127 my ($elem, $following) = @_;
128
129 my $parent = $elem->parent();
130 while ($parent) {
131 if ( $parent->isa('PPI::Structure::Condition') ) {
132 return
133 _is_in_correct_position_in_a_structure_condition(
134 $elem, $parent, $following,
135 );
136 }
137
138 # TECHNICAL DEBT: This code is basically shared with
139 # ProhibitUnusedCapture. I don't want to put this code
140 # into Perl::Critic::Utils::*, but I don't have time to sort out
141 # PPIx::Utilities::Structure::List yet.
142 if (
143 $parent->isa('PPI::Structure::List')
144 and my $parent_statement = $parent->statement()
145 ) {
146 return $TRUE if
147 $parent_statement->isa('PPI::Statement::Compound')
148 and $parent_statement->type() eq 'foreach';
149 }
150
151 if ( $parent->isa('PPI::Structure::For') ) {
152 my @for_loop_components = $parent->schildren();
153
154 my $condition =
155 $for_loop_components[$CONDITION_POSITION_IN_C_STYLE_FOR_LOOP]
156 or return;
157
158 return _descendant_of($elem, $condition);
159 }
160
161 $parent = $parent->parent();
162 }
163
164 return;
165}
166
167sub _is_in_correct_position_in_a_structure_condition {
168 my ($elem, $parent, $following) = @_;
169
170 my $level = $elem;
171 while ($level and refaddr $level != $parent) {
172 my $cursor = refaddr $elem == refaddr $level ? $following : $level;
173
174 IS_FINAL_EXPRESSION_AT_DEPTH:
175 while ($cursor) {
176 if ( _is_effectively_a_comma($cursor) ) {
177 $cursor = $cursor->snext_sibling();
178 while ( _is_effectively_a_comma($cursor) ) {
179 $cursor = $cursor->snext_sibling();
180 }
181
182 # Semicolon would be a syntax error here.
183 return if $cursor;
184 last IS_FINAL_EXPRESSION_AT_DEPTH;
185 }
186
187 $cursor = $cursor->snext_sibling();
188 }
189
190 my $statement = $level->parent();
191 return $TRUE if not $statement; # Shouldn't happen.
192 return $TRUE if not $statement->isa('PPI::Statement'); # Shouldn't happen.
193
194 $level = $statement->parent();
195 if (
196 not $level
197 or (
198 not $level->isa('PPI::Structure::List')
199 and not $level->isa('PPI::Structure::Condition')
200 )
201 ) {
202 # Shouldn't happen.
203 return $TRUE;
204 }
205 }
206
207 return $TRUE;
208}
209
210# Replace with PPI implementation once it is released.
211sub _descendant_of {
212 my ($cursor, $potential_ancestor) = @_;
213
214 return $EMPTY if not $potential_ancestor;
215
216 while ( refaddr $cursor != refaddr $potential_ancestor ) {
217 $cursor = $cursor->parent() or return $EMPTY;
218 }
219
220 return 1;
221}
222
223#-----------------------------------------------------------------------------
224
225sub _is_in_postfix_expression {
226 my ($elem) = @_;
227
228 my $current_base = $elem;
229 while ($TRUE) {
230 my $previous = $current_base->sprevious_sibling();
231 while ($previous) {
232 if (
233 $previous->isa('PPI::Token::Word')
234 and $POSTFIX_OPERATORS{ $previous->content() }
235 ) {
236 return $TRUE
237 }
238 $previous = $previous->sprevious_sibling();
239 } # end while
240
241 my $parent = $current_base->parent() or return;
242 if ( $parent->isa('PPI::Statement') ) {
243 return if $parent->specialized();
244
245 my $grandparent = $parent->parent() or return;
246 return if not $grandparent->isa('PPI::Structure::List');
247
248 $current_base = $grandparent;
249 } else {
250 $current_base = $parent;
251 }
252
253 return if not $current_base->isa('PPI::Structure::List');
254 }
255
256 return;
257}
258
259#-----------------------------------------------------------------------------
260
261sub _scan_backwards_for_grep {
262 my ( $elem ) = @_;
263
264 while ( $elem ) {
265
266 my $parent = $elem->parent();
267
268 while ( $elem = $elem->sprevious_sibling() ) {
269 $elem->isa( 'PPI::Token::Word' )
270 and 'grep' eq $elem->content()
271 and return $TRUE;
272 $elem->isa( 'PPI::Token::Operator' )
273 and precedence_of( $elem ) >= $PRECEDENCE_OF_EQUALS
274 and return $FALSE;
275 }
276
277 $elem = $parent;
278 }
279
280 return $FALSE;
281
282}
283
284#-----------------------------------------------------------------------------
285
286sub _is_effectively_a_comma {
287 my ($elem) = @_;
288
289 return if not $elem;
290
291 return
292 $elem->isa('PPI::Token::Operator')
293 && (
294 $elem->content() eq $COMMA
295 || $elem->content() eq $FATCOMMA
296 );
297}
298
299#-----------------------------------------------------------------------------
300
30117µs1;
302
303__END__