← 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/Variables/RequireNegativeIndices.pm
StatementsExecuted 19 statements in 856µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11116µs16µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::BEGIN@10Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@10
1118µs60µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::BEGIN@16Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@16
1118µs11µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::BEGIN@12Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@12
1117µs27µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::BEGIN@13Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@13
1117µs152µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::BEGIN@15Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@15
1117µs18µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::BEGIN@11Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@11
1115µs6µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::default_severityPerl::Critic::Policy::Variables::RequireNegativeIndices::default_severity
1111µs1µsPerl::Critic::Policy::Variables::RequireNegativeIndices::::supported_parametersPerl::Critic::Policy::Variables::RequireNegativeIndices::supported_parameters
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_arrayindexPerl::Critic::Policy::Variables::RequireNegativeIndices::_arrayindex
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_castPerl::Critic::Policy::Variables::RequireNegativeIndices::_cast
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_is_array_namePerl::Critic::Policy::Variables::RequireNegativeIndices::_is_array_name
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_is_bad_indexPerl::Critic::Policy::Variables::RequireNegativeIndices::_is_bad_index
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_is_bad_var_in_indexPerl::Critic::Policy::Variables::RequireNegativeIndices::_is_bad_var_in_index
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_is_dereferencerPerl::Critic::Policy::Variables::RequireNegativeIndices::_is_dereferencer
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_is_minus_numberPerl::Critic::Policy::Variables::RequireNegativeIndices::_is_minus_number
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::_symbolPerl::Critic::Policy::Variables::RequireNegativeIndices::_symbol
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::applies_toPerl::Critic::Policy::Variables::RequireNegativeIndices::applies_to
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::default_themesPerl::Critic::Policy::Variables::RequireNegativeIndices::default_themes
0000s0sPerl::Critic::Policy::Variables::RequireNegativeIndices::::violatesPerl::Critic::Policy::Variables::RequireNegativeIndices::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::Variables::RequireNegativeIndices;
9
10242µs116µs
# spent 16µs within Perl::Critic::Policy::Variables::RequireNegativeIndices::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::Variables::RequireNegativeIndices::BEGIN@10
11220µs229µs
# spent 18µs (7+11) within Perl::Critic::Policy::Variables::RequireNegativeIndices::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::Variables::RequireNegativeIndices::BEGIN@11 # spent 11µs making 1 call to strict::import
12218µs215µs
# spent 11µs (8+4) within Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@12 which was called: # once (8µs+4µs) by Module::Pluggable::Object::_require at line 12
use warnings;
# spent 11µs making 1 call to Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@12 # spent 4µs making 1 call to warnings::import
13222µs248µs
# spent 27µs (7+20) within Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@13 which was called: # once (7µs+20µs) by Module::Pluggable::Object::_require at line 13
use Readonly;
# spent 27µs making 1 call to Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@13 # spent 20µs making 1 call to Exporter::import
14
15224µs2297µs
# spent 152µs (7+145) within Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@15 which was called: # once (7µs+145µs) by Module::Pluggable::Object::_require at line 15
use Perl::Critic::Utils qw{ :severities };
# spent 152µs making 1 call to Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@15 # spent 145µs making 1 call to Exporter::import
162717µs2113µs
# spent 60µs (8+53) within Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@16 which was called: # once (8µs+53µs) by Module::Pluggable::Object::_require at line 16
use base 'Perl::Critic::Policy';
# spent 60µs making 1 call to Perl::Critic::Policy::Variables::RequireNegativeIndices::BEGIN@16 # spent 53µs making 1 call to base::import
17
181600nsour $VERSION = '1.121';
19
20#-----------------------------------------------------------------------------
21
2212µs129µsReadonly::Scalar my $DESC => q{Negative array index should be used};
# spent 29µs making 1 call to Readonly::Scalar
2312µs143µsReadonly::Scalar my $EXPL => [ 88 ];
# spent 43µs making 1 call to Readonly::Scalar
24
25#-----------------------------------------------------------------------------
26
2714µs
# spent 1µs within Perl::Critic::Policy::Variables::RequireNegativeIndices::supported_parameters which was called: # once (1µs+0s) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters { return () }
2811µs
# spent 6µs (5+1) within Perl::Critic::Policy::Variables::RequireNegativeIndices::default_severity which was called: # once (5µs+1µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm
sub default_severity { return $SEVERITY_HIGH }
29sub default_themes { return qw( core maintenance pbp ) }
30sub applies_to { return 'PPI::Structure::Subscript' }
31
32#-----------------------------------------------------------------------------
33
34sub violates {
35 my ( $self, $elem, $doc ) = @_;
36
37 return if $elem->braces ne '[]';
38 my ($name, $isref) = _is_bad_index( $elem );
39 return if ( !$name );
40 return if !_is_array_name( $elem, $name, $isref );
41 return $self->violation( $DESC, $EXPL, $elem );
42}
43
4411µs120µsReadonly::Scalar my $MAX_EXPRESSION_COMPLEXETY => 4;
# spent 20µs making 1 call to Readonly::Scalar
45
46sub _is_bad_index {
47 # return (varname, 0|1) if this could be a violation
48 my ( $elem ) = @_;
49
50 my @children = $elem->schildren();
51 return if @children != 1; # too complex
52 return if !$children[0]->isa( 'PPI::Statement::Expression'); # too complex
53
54 # This is the expression elements that compose the array indexing
55 my @expr = $children[0]->schildren();
56 return if !@expr || @expr > $MAX_EXPRESSION_COMPLEXETY;
57 my ($name, $isref, $isindex) = _is_bad_var_in_index(\@expr);
58 return if !$name;
59 return $name, $isref if !@expr && $isindex;
60 return if !_is_minus_number(@expr);
61 return $name, $isref;
62}
63
64sub _is_bad_var_in_index {
65 # return (varname, isref=0|1, isindex=0|1) if this could be a violation
66 my ( $expr ) = @_;
67
68 if ( $expr->[0]->isa('PPI::Token::ArrayIndex') ) {
69 # [$#arr]
70 return _arrayindex($expr);
71 }
72 elsif ( $expr->[0]->isa('PPI::Token::Cast') ) {
73 # [$#{$arr} ...] or [$#$arr ...] or [@{$arr} ...] or [@$arr ...]
74 return _cast($expr);
75 }
76 elsif ($expr->[0]->isa('PPI::Token::Symbol')) {
77 # [@arr ...]
78 return _symbol($expr);
79 }
80
81 return;
82}
83
84sub _arrayindex {
85 # return (varname, isref=0|1, isindex=0|1) if this could be a violation
86 my ( $expr ) = @_;
87 my $arrindex = shift @{$expr};
88 if ($arrindex->content =~ m/\A \$[#] (.*) \z /xms) { # What else could it be???
89 return $1, 0, 1;
90 }
91 return;
92}
93
94sub _cast {
95 # return (varname, isref=0|1, isindex=0|1) if this could be a violation
96 my ( $expr ) = @_;
97 my $cast = shift @{$expr};
98 if ( $cast eq q{$#} || $cast eq q{@} ) { ## no critic(RequireInterpolationOfMetachars)
99 my $isindex = $cast eq q{$#} ? 1 : 0; ## no critic(RequireInterpolationOfMetachars)
100 my $arrvar = shift @{$expr};
101 if ($arrvar->isa('PPI::Structure::Block')) {
102 # look for [$#{$arr} ...] or [@{$arr} ...]
103 my @blockchildren = $arrvar->schildren();
104 return if @blockchildren != 1;
105 return if !$blockchildren[0]->isa('PPI::Statement');
106 my @ggg = $blockchildren[0]->schildren;
107 return if @ggg != 1;
108 return if !$ggg[0]->isa('PPI::Token::Symbol');
109 if ($ggg[0] =~ m/\A \$ (.*) \z/xms) {
110 return $1, 1, $isindex;
111 }
112 }
113 elsif ( $arrvar->isa('PPI::Token::Symbol') ) {
114 # look for [$#$arr ...] or [@$arr ...]
115 if ($arrvar =~ m/\A \$ (.*) \z/xms) {
116 return $1, 1, $isindex;
117 }
118 }
119 }
120 return;
121}
122
123sub _symbol {
124 # return (varname, isref=0|1, isindex=0|1) if this could be a violation
125 my ( $expr ) = @_;
126 my $arrvar = shift @{$expr};
127 if ($arrvar =~ m/\A \@ (.*) \z/xms) {
128 return $1, 0, 0;
129 }
130 return;
131}
132
133sub _is_minus_number { # return true if @expr looks like "- n"
134 my @expr = @_;
135
136 return if !@expr;
137
138 return if @expr != 2;
139
140 my $op = shift @expr;
141 return if !$op->isa('PPI::Token::Operator');
142 return if $op ne q{-};
143
144 my $number = shift @expr;
145 return if !$number->isa('PPI::Token::Number');
146
147 return 1;
148}
149
150sub _is_array_name { # return true if name and isref matches
151 my ( $elem, $name, $isref ) = @_;
152
153 my $sib = $elem->sprevious_sibling;
154 return if !$sib;
155
156 if ($sib->isa('PPI::Token::Operator') && $sib eq '->') {
157 return if ( !$isref );
158 $isref = 0;
159 $sib = $sib->sprevious_sibling;
160 return if !$sib;
161 }
162
163 return if !$sib->isa('PPI::Token::Symbol');
164 return if $sib !~ m/\A \$ \Q$name\E \z/xms;
165
166 my $cousin = $sib->sprevious_sibling;
167 return if $isref ^ _is_dereferencer( $cousin );
168 return if $isref && _is_dereferencer( $cousin->sprevious_sibling );
169
170 return $elem;
171}
172
173sub _is_dereferencer { # must return 0 or 1, not undef
174 my $elem = shift;
175
176 return 0 if !$elem;
177 return 1 if $elem->isa('PPI::Token::Operator') && $elem eq '->';
178 return 1 if $elem->isa('PPI::Token::Cast');
179 return 0;
180}
181
18214µs1;
183
184#-----------------------------------------------------------------------------
185
186__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.