| 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 | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@10 |
| 1 | 1 | 1 | 11µs | 32µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@14 |
| 1 | 1 | 1 | 9µs | 11µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::default_severity |
| 1 | 1 | 1 | 8µs | 29µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@16 |
| 1 | 1 | 1 | 8µs | 12µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@12 |
| 1 | 1 | 1 | 7µs | 19µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@11 |
| 1 | 1 | 1 | 7µs | 57µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@20 |
| 1 | 1 | 1 | 7µs | 399µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::BEGIN@18 |
| 1 | 1 | 1 | 2µs | 2µs | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::supported_parameters |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_descendant_of |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_grandparent_for_is_in_right_hand_side_of_assignment |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_effectively_a_comma |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_correct_position_in_a_condition_or_foreach_loop_collection |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_correct_position_in_a_structure_condition |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_postfix_expression |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_is_in_right_hand_side_of_assignment |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::_scan_backwards_for_grep |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::applies_to |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::default_themes |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval::violates |
| 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__ |