Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/ValuesAndExpressions/ProhibitCommaSeparatedStatements.pm |
Statements | Executed 20 statements in 634µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 16µs | 16µs | BEGIN@10 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 14µs | 16µs | supported_parameters | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 9µs | 30µs | BEGIN@17 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 8µs | 12µs | BEGIN@12 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 7µs | 28µs | BEGIN@13 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 7µs | 58µs | BEGIN@19 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 7µs | 615µs | BEGIN@16 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 7µs | 18µs | BEGIN@11 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
1 | 1 | 1 | 6µs | 7µs | default_severity | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | _is_direct_part_of_map_or_grep_block | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | _is_last_statement_in_a_block | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | _is_parent_a_constructor_or_list | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | _is_parent_a_for_loop | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | _succeeding_commas_are_list_element_separators | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | applies_to | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | default_themes | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
0 | 0 | 0 | 0s | 0s | violates | Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::
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::ValuesAndExpressions::ProhibitCommaSeparatedStatements; | ||||
9 | |||||
10 | 2 | 39µs | 1 | 16µs | # spent 16µs within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@10 which was called:
# once (16µs+0s) by Module::Pluggable::Object::_require at line 10 # spent 16µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@10 |
11 | 2 | 24µs | 2 | 29µs | # spent 18µs (7+11) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@11 which was called:
# once (7µs+11µs) by Module::Pluggable::Object::_require at line 11 # spent 18µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@11
# spent 11µs making 1 call to strict::import |
12 | 2 | 18µs | 2 | 15µs | # spent 12µs (8+4) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::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::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@12
# spent 4µs making 1 call to warnings::import |
13 | 2 | 24µs | 2 | 48µs | # spent 28µs (7+21) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@13 which was called:
# once (7µs+21µs) by Module::Pluggable::Object::_require at line 13 # spent 28µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@13
# spent 21µs making 1 call to Exporter::import |
14 | |||||
15 | |||||
16 | 2 | 25µs | 2 | 1.22ms | # spent 615µs (7+608) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@16 which was called:
# once (7µs+608µs) by Module::Pluggable::Object::_require at line 16 # spent 615µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@16
# spent 608µs making 1 call to Exporter::import |
17 | 2 | 28µs | 2 | 52µs | # spent 30µs (9+21) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@17 which was called:
# once (9µs+21µs) by Module::Pluggable::Object::_require at line 17 # spent 30µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@17
# spent 21µs making 1 call to Exporter::import |
18 | |||||
19 | 2 | 456µs | 2 | 108µs | # spent 58µs (7+51) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@19 which was called:
# once (7µs+51µs) by Module::Pluggable::Object::_require at line 19 # spent 58µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::BEGIN@19
# spent 51µs making 1 call to base::import |
20 | |||||
21 | 1 | 600ns | our $VERSION = '1.121'; | ||
22 | |||||
23 | #----------------------------------------------------------------------------- | ||||
24 | |||||
25 | 1 | 2µs | 1 | 30µs | Readonly::Scalar my $DESC => q{Comma used to separate statements}; # spent 30µs making 1 call to Readonly::Scalar |
26 | 1 | 2µs | 1 | 43µs | Readonly::Scalar my $EXPL => [ 68, 71 ]; # spent 43µs making 1 call to Readonly::Scalar |
27 | |||||
28 | #----------------------------------------------------------------------------- | ||||
29 | |||||
30 | # spent 16µs (14+2) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::supported_parameters which was called:
# once (14µs+2µs) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm | ||||
31 | return ( | ||||
32 | { | ||||
33 | 1 | 11µs | 2 | 2µs | name => 'allow_last_statement_to_be_comma_separated_in_map_and_grep', # spent 2µs making 2 calls to Readonly::Scalar::FETCH, avg 950ns/call |
34 | description => 'Allow map and grep blocks to return lists.', | ||||
35 | default_string => $FALSE, | ||||
36 | behavior => 'boolean', | ||||
37 | }, | ||||
38 | ); | ||||
39 | } | ||||
40 | |||||
41 | 1 | 2µs | # spent 7µs (6+1) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements::default_severity which was called:
# once (6µs+1µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm | ||
42 | sub default_themes { return qw( core bugs pbp certrule ) } | ||||
43 | sub applies_to { return 'PPI::Statement' } | ||||
44 | |||||
45 | #----------------------------------------------------------------------------- | ||||
46 | |||||
47 | sub violates { | ||||
48 | my ( $self, $elem, undef ) = @_; | ||||
49 | |||||
50 | # Grrr... PPI instantiates non-leaf nodes in its class hierarchy... | ||||
51 | return if is_ppi_statement_subclass($elem); | ||||
52 | |||||
53 | # Now, if PPI hasn't introduced any new PPI::Statement subclasses, we've | ||||
54 | # got an element who's class really is PPI::Statement. | ||||
55 | |||||
56 | return if _is_parent_a_constructor_or_list($elem); | ||||
57 | return if _is_parent_a_for_loop($elem); | ||||
58 | |||||
59 | if ( | ||||
60 | $self->{_allow_last_statement_to_be_comma_separated_in_map_and_grep} | ||||
61 | ) { | ||||
62 | return if not _is_direct_part_of_map_or_grep_block($elem); | ||||
63 | } | ||||
64 | |||||
65 | foreach my $child ( $elem->schildren() ) { | ||||
66 | if ( | ||||
67 | not $self->{_allow_last_statement_to_be_comma_separated_in_map_and_grep} | ||||
68 | and not _is_last_statement_in_a_block($child) | ||||
69 | ) { | ||||
70 | if ( $child->isa('PPI::Token::Word') ) { | ||||
71 | return if _succeeding_commas_are_list_element_separators($child); | ||||
72 | } | ||||
73 | elsif ( $child->isa('PPI::Token::Operator') ) { | ||||
74 | if ( $child->content() eq $COMMA ) { | ||||
75 | return $self->violation($DESC, $EXPL, $elem); | ||||
76 | } | ||||
77 | } | ||||
78 | } | ||||
79 | } | ||||
80 | |||||
81 | return; | ||||
82 | } | ||||
83 | |||||
84 | sub _is_parent_a_constructor_or_list { | ||||
85 | my ($elem) = @_; | ||||
86 | |||||
87 | my $parent = $elem->parent(); | ||||
88 | |||||
89 | return if not $parent; | ||||
90 | |||||
91 | return ( | ||||
92 | $parent->isa('PPI::Structure::Constructor') | ||||
93 | or $parent->isa('PPI::Structure::List') | ||||
94 | ); | ||||
95 | } | ||||
96 | |||||
97 | sub _is_parent_a_for_loop { | ||||
98 | my ($elem) = @_; | ||||
99 | |||||
100 | my $parent = $elem->parent(); | ||||
101 | |||||
102 | return if not $parent; | ||||
103 | |||||
104 | return if not $parent->isa('PPI::Structure::For'); | ||||
105 | |||||
106 | return 1 == scalar $parent->schildren(); # Multiple means C-style loop. | ||||
107 | } | ||||
108 | |||||
109 | sub _is_direct_part_of_map_or_grep_block { | ||||
110 | my ($elem) = @_; | ||||
111 | |||||
112 | my $parent = $elem->parent(); | ||||
113 | return if not $parent; | ||||
114 | return if not $parent->isa('PPI::Structure::Block'); | ||||
115 | |||||
116 | my $block_prior_sibling = $parent->sprevious_sibling(); | ||||
117 | return if not $block_prior_sibling; | ||||
118 | return if not $block_prior_sibling->isa('PPI::Token::Word'); | ||||
119 | |||||
120 | return $block_prior_sibling eq 'map' || $block_prior_sibling eq 'grep'; | ||||
121 | } | ||||
122 | |||||
123 | sub _is_last_statement_in_a_block { | ||||
124 | my ($elem) = @_; | ||||
125 | |||||
126 | my $parent = $elem->parent(); | ||||
127 | return if not $parent; | ||||
128 | return if not $parent->isa('PPI::Structure::Block'); | ||||
129 | |||||
130 | my $next_sibling = $elem->snext_sibling(); | ||||
131 | return if not $next_sibling; | ||||
132 | |||||
133 | return 1; | ||||
134 | } | ||||
135 | |||||
136 | sub _succeeding_commas_are_list_element_separators { | ||||
137 | my ($elem) = @_; | ||||
138 | |||||
139 | if ( | ||||
140 | is_perl_builtin_with_zero_and_or_one_arguments($elem) | ||||
141 | and not is_perl_builtin_with_multiple_arguments($elem) | ||||
142 | ) { | ||||
143 | return; | ||||
144 | } | ||||
145 | |||||
146 | my $sibling = $elem->snext_sibling(); | ||||
147 | |||||
148 | return 1 if not $sibling; # There won't be any succeeding commas. | ||||
149 | |||||
150 | return not $sibling->isa('PPI::Structure::List'); | ||||
151 | } | ||||
152 | |||||
153 | 1 | 3µs | 1; | ||
154 | |||||
155 | __END__ |