Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/ErrorHandling/RequireCheckingReturnValueOfEval.pm |
Statements | Executed 24 statements in 1.15ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 17µs | 17µs | BEGIN@10 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 11µs | 32µs | BEGIN@14 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 9µs | 11µs | default_severity | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 8µs | 29µs | BEGIN@16 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 8µs | 12µs | BEGIN@12 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 7µs | 19µs | BEGIN@11 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 7µs | 57µs | BEGIN@20 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 7µs | 399µs | BEGIN@18 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
1 | 1 | 1 | 2µs | 2µs | supported_parameters | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _descendant_of | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _grandparent_for_is_in_right_hand_side_of_assignment | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _is_effectively_a_comma | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _is_in_correct_position_in_a_condition_or_foreach_loop_collection | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _is_in_correct_position_in_a_structure_condition | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _is_in_postfix_expression | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _is_in_right_hand_side_of_assignment | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | _scan_backwards_for_grep | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | applies_to | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | default_themes | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
0 | 0 | 0 | 0s | 0s | violates | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | ############################################################################## | ||||
2 | # $URL$ | ||||
3 | # $Date$ | ||||
4 | # $Author$ | ||||
5 | # $Revision$ | ||||
6 | ############################################################################## | ||||
7 | |||||
8 | package Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval; | ||||
9 | |||||
10 | 2 | 40µs | 1 | 17µ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 # spent 17µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@10 |
11 | 2 | 20µs | 2 | 30µ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 # spent 19µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@11
# spent 11µs making 1 call to strict::import |
12 | 2 | 19µs | 2 | 15µ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 # spent 12µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@12
# spent 4µs making 1 call to warnings::import |
13 | |||||
14 | 2 | 23µs | 2 | 53µ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 # spent 32µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@14
# spent 21µs making 1 call to Exporter::import |
15 | |||||
16 | 2 | 24µs | 2 | 50µ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 # spent 29µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@16
# spent 21µs making 1 call to Exporter::import |
17 | |||||
18 | 1 | 200ns | # 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 | ||
19 | 1 | 24µs | 2 | 792µ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 |
20 | 2 | 971µs | 2 | 107µ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 # spent 57µs making 1 call to Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@20
# spent 50µs making 1 call to base::import |
21 | |||||
22 | 1 | 700ns | our $VERSION = '1.121'; | ||
23 | |||||
24 | #----------------------------------------------------------------------------- | ||||
25 | |||||
26 | 1 | 2µs | 1 | 32µs | Readonly::Scalar my $DESC => 'Return value of eval not tested.'; # spent 32µs making 1 call to Readonly::Scalar |
27 | ## no critic (RequireInterpolationOfMetachars) | ||||
28 | 1 | 1µs | 1 | 23µs | Readonly::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 | |||||
32 | 1 | 3µs | 2 | 32µs | Readonly::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 |
33 | 1 | 3µs | 2 | 30µs | Readonly::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 | |||||
36 | 1 | 3µs | 2 | 43µs | Readonly::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 | |||||
40 | 1 | 4µ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 | ||
41 | 1 | 2µ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 | ||
42 | sub default_themes { return qw( core bugs ) } | ||||
43 | sub applies_to { return 'PPI::Token::Word' } | ||||
44 | |||||
45 | #----------------------------------------------------------------------------- | ||||
46 | |||||
47 | sub 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 | |||||
75 | sub _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 | |||||
104 | sub _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 | |||||
124 | 1 | 1µs | 1 | 23µs | Readonly::Scalar my $CONDITION_POSITION_IN_C_STYLE_FOR_LOOP => 1; # spent 23µs making 1 call to Readonly::Scalar |
125 | |||||
126 | sub _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 | |||||
167 | sub _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. | ||||
211 | sub _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 | |||||
225 | sub _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 | |||||
261 | sub _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 | |||||
286 | sub _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 | |||||
301 | 1 | 7µs | 1; | ||
302 | |||||
303 | __END__ |