| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use 5.006001; |
|
3
|
2
|
|
|
2
|
|
424164
|
use strict; |
|
|
2
|
|
|
|
|
16
|
|
|
4
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
|
2
|
|
|
|
|
26
|
|
|
|
2
|
|
|
|
|
40
|
|
|
5
|
2
|
|
|
2
|
|
12
|
|
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
63
|
|
|
6
|
|
|
|
|
|
|
use English qw{ -no_match_vars }; |
|
7
|
2
|
|
|
2
|
|
10
|
|
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
22
|
|
|
8
|
|
|
|
|
|
|
use PPI::Document; |
|
9
|
2
|
|
|
2
|
|
1039
|
use PPIx::QuoteLike 0.011; |
|
|
2
|
|
|
|
|
32878
|
|
|
|
2
|
|
|
|
|
67
|
|
|
10
|
2
|
|
|
2
|
|
1006
|
use PPIx::QuoteLike::Constant 0.011 qw{ |
|
|
2
|
|
|
|
|
250610
|
|
|
|
2
|
|
|
|
|
123
|
|
|
11
|
2
|
|
|
|
|
142
|
LOCATION_LINE |
|
12
|
|
|
|
|
|
|
LOCATION_LOGICAL_FILE |
|
13
|
|
|
|
|
|
|
LOCATION_LOGICAL_LINE |
|
14
|
|
|
|
|
|
|
LOCATION_CHARACTER |
|
15
|
|
|
|
|
|
|
LOCATION_COLUMN |
|
16
|
|
|
|
|
|
|
}; |
|
17
|
2
|
|
|
2
|
|
21
|
use PPIx::Regexp 0.071; |
|
|
2
|
|
|
|
|
32
|
|
|
18
|
2
|
|
|
2
|
|
12
|
use Readonly; |
|
|
2
|
|
|
|
|
38
|
|
|
|
2
|
|
|
|
|
52
|
|
|
19
|
2
|
|
|
2
|
|
11
|
use Scalar::Util qw{ refaddr }; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
102
|
|
|
20
|
2
|
|
|
2
|
|
17
|
|
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
119
|
|
|
21
|
|
|
|
|
|
|
use Perl::Critic::Exception::Fatal::PolicyDefinition; |
|
22
|
2
|
|
|
2
|
|
16
|
use Perl::Critic::Exception::Fatal::Internal qw{ throw_internal }; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
75
|
|
|
23
|
2
|
|
|
2
|
|
12
|
use Perl::Critic::Utils qw< :booleans :characters hashify :severities >; |
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
90
|
|
|
24
|
2
|
|
|
2
|
|
11
|
|
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
138
|
|
|
25
|
|
|
|
|
|
|
use base 'Perl::Critic::Policy'; |
|
26
|
2
|
|
|
2
|
|
659
|
|
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
1153
|
|
|
27
|
|
|
|
|
|
|
our $VERSION = '0.113_01'; |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Readonly::Scalar my $EXPL => |
|
32
|
|
|
|
|
|
|
q<Unused variables clutter code and make it harder to read>; |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Determine whether a PPI::Statement::Variable refers to a global or a |
|
35
|
|
|
|
|
|
|
# lexical variable. We need to track globals to avoid false negatives |
|
36
|
|
|
|
|
|
|
# from things like |
|
37
|
|
|
|
|
|
|
# |
|
38
|
|
|
|
|
|
|
# my $foo; |
|
39
|
|
|
|
|
|
|
# { |
|
40
|
|
|
|
|
|
|
# our $foo; |
|
41
|
|
|
|
|
|
|
# $foo = 'bar'; |
|
42
|
|
|
|
|
|
|
# } |
|
43
|
|
|
|
|
|
|
# |
|
44
|
|
|
|
|
|
|
# but we do not need to track 'local', because if you |
|
45
|
|
|
|
|
|
|
# s/ \b our \b /local/smxg |
|
46
|
|
|
|
|
|
|
# in the above, Perl complains that you can not localize a lexical |
|
47
|
|
|
|
|
|
|
# variable, rather than localizing the corresponding global variable. |
|
48
|
|
|
|
|
|
|
Readonly::Hash my %GLOBAL_DECLARATION => ( |
|
49
|
|
|
|
|
|
|
my => $FALSE, |
|
50
|
|
|
|
|
|
|
state => $FALSE, |
|
51
|
|
|
|
|
|
|
our => $TRUE, |
|
52
|
|
|
|
|
|
|
); |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Readonly::Scalar my $CATCH => 'catch'; |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Readonly::Scalar my $PACKAGE => '_' . __PACKAGE__; |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Readonly::Scalar my $LEFT_BRACE => q<{>; # } Seems P::C::U should have |
|
59
|
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Readonly::Hash my %IS_COMMA => hashify( $COMMA, $FATCOMMA ); |
|
61
|
|
|
|
|
|
|
Readonly::Hash my %IS_INC_DEC => hashify( qw{ ++ -- } ); |
|
62
|
|
|
|
|
|
|
Readonly::Hash my %LOW_PRECEDENCE_BOOLEAN => hashify( qw{ and or xor } ); |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Readonly::Array my @DOUBLE_QUOTISH => qw{ |
|
65
|
|
|
|
|
|
|
PPI::Token::Quote::Double |
|
66
|
|
|
|
|
|
|
PPI::Token::Quote::Interpolate |
|
67
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Backtick |
|
68
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Command |
|
69
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Readline |
|
70
|
|
|
|
|
|
|
PPI::Token::HereDoc |
|
71
|
|
|
|
|
|
|
}; |
|
72
|
|
|
|
|
|
|
Readonly::Array my @REGEXP_ISH => qw{ |
|
73
|
|
|
|
|
|
|
PPI::Token::Regexp::Match |
|
74
|
|
|
|
|
|
|
PPI::Token::Regexp::Substitute |
|
75
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Regexp |
|
76
|
|
|
|
|
|
|
}; |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
{ |
|
81
|
|
|
|
|
|
|
name => 'allow_if_computed_by', |
|
82
|
|
|
|
|
|
|
description => 'Allow if computed by one of these', |
|
83
|
61
|
|
|
61
|
0
|
303189
|
behavior => 'string list', |
|
84
|
|
|
|
|
|
|
}, |
|
85
|
|
|
|
|
|
|
{ name => 'prohibit_reference_only_variables', |
|
86
|
|
|
|
|
|
|
description => 'Prohibit reference-only variables', |
|
87
|
|
|
|
|
|
|
behavior => 'boolean', |
|
88
|
|
|
|
|
|
|
default_string => '0', |
|
89
|
|
|
|
|
|
|
}, |
|
90
|
|
|
|
|
|
|
{ name => 'prohibit_returned_lexicals', |
|
91
|
|
|
|
|
|
|
description => 'Prohibit returned lexicals', |
|
92
|
|
|
|
|
|
|
behavior => 'boolean', |
|
93
|
|
|
|
|
|
|
default_string => '0', |
|
94
|
|
|
|
|
|
|
}, |
|
95
|
|
|
|
|
|
|
{ name => 'allow_unused_subroutine_arguments', |
|
96
|
|
|
|
|
|
|
description => 'Allow unused subroutine arguments', |
|
97
|
|
|
|
|
|
|
behavior => 'boolean', |
|
98
|
|
|
|
|
|
|
default_string => '0', |
|
99
|
|
|
|
|
|
|
}, |
|
100
|
|
|
|
|
|
|
{ |
|
101
|
|
|
|
|
|
|
name => 'allow_state_in_expression', |
|
102
|
|
|
|
|
|
|
description => 'Allow state variable with low-precedence Boolean', |
|
103
|
|
|
|
|
|
|
behavior => 'boolean', |
|
104
|
|
|
|
|
|
|
default_string => '0', |
|
105
|
|
|
|
|
|
|
}, |
|
106
|
|
|
|
|
|
|
{ |
|
107
|
|
|
|
|
|
|
name => 'check_catch', |
|
108
|
|
|
|
|
|
|
description => 'Check the catch() clause of try/catch', |
|
109
|
|
|
|
|
|
|
behavior => 'boolean', |
|
110
|
|
|
|
|
|
|
default_string => '0', |
|
111
|
|
|
|
|
|
|
}, |
|
112
|
|
|
|
|
|
|
{ |
|
113
|
|
|
|
|
|
|
name => 'dump', |
|
114
|
|
|
|
|
|
|
description => 'UNSUPPORTED: Dump symbol definitions', |
|
115
|
|
|
|
|
|
|
behavior => 'boolean', |
|
116
|
|
|
|
|
|
|
default_string => '0', |
|
117
|
|
|
|
|
|
|
}, |
|
118
|
|
|
|
|
|
|
{ |
|
119
|
|
|
|
|
|
|
name => 'trace', |
|
120
|
|
|
|
|
|
|
description => 'UNSUPPORTED: Trace variable processing', |
|
121
|
|
|
|
|
|
|
behavior => 'string list', |
|
122
|
|
|
|
|
|
|
}, |
|
123
|
|
|
|
|
|
|
) } |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
127
|
44
|
|
|
44
|
1
|
2653
|
|
|
128
|
0
|
|
|
0
|
1
|
0
|
# my ( $self, $elem, $document ) = @_; |
|
129
|
60
|
|
|
60
|
1
|
697456
|
my ( $self, undef, $document ) = @_; |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
$self->{$PACKAGE} = { |
|
132
|
|
|
|
|
|
|
declared => {}, # Keyed by PPI::Token::Symbol->symbol(). |
|
133
|
|
|
|
|
|
|
# Values are a list of hashes |
|
134
|
|
|
|
|
|
|
# representing declarations of the given |
|
135
|
60
|
|
|
60
|
1
|
897
|
# symbol, in reverse order. In each |
|
136
|
|
|
|
|
|
|
# hash: |
|
137
|
60
|
|
|
|
|
694
|
# {declaration} is the PPI statement |
|
138
|
|
|
|
|
|
|
# object in which the variable is |
|
139
|
|
|
|
|
|
|
# declared; |
|
140
|
|
|
|
|
|
|
# {element} is the PPI::Token::Symbol |
|
141
|
|
|
|
|
|
|
# {is_allowed_computation} is true |
|
142
|
|
|
|
|
|
|
# if the value of the symbol is |
|
143
|
|
|
|
|
|
|
# initialized using one of the |
|
144
|
|
|
|
|
|
|
# allowed subroutines or classes |
|
145
|
|
|
|
|
|
|
# (e.g. Scope::Guard). |
|
146
|
|
|
|
|
|
|
# {is_global} is true if the declaration |
|
147
|
|
|
|
|
|
|
# is a global (i.e. is 'our', not 'my'); |
|
148
|
|
|
|
|
|
|
# {is_state_in_expression} is true if |
|
149
|
|
|
|
|
|
|
# the variable is a 'state' variable |
|
150
|
|
|
|
|
|
|
# and the assignment is part of an |
|
151
|
|
|
|
|
|
|
# expression. |
|
152
|
|
|
|
|
|
|
# {is_unpacking} is true if the |
|
153
|
|
|
|
|
|
|
# declaration occurs in an argument |
|
154
|
|
|
|
|
|
|
# unpacking; |
|
155
|
|
|
|
|
|
|
# {taking_reference} is true if the code |
|
156
|
|
|
|
|
|
|
# takes a reference to the declared |
|
157
|
|
|
|
|
|
|
# variable; |
|
158
|
|
|
|
|
|
|
# {used} is a count of the number of |
|
159
|
|
|
|
|
|
|
# times that declaration was used, |
|
160
|
|
|
|
|
|
|
# initialized to 0. |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
is_declaration => {}, # Keyed by refaddr of PPI::Token::Symbol. |
|
163
|
|
|
|
|
|
|
# True if the object represents a |
|
164
|
|
|
|
|
|
|
# declaration. |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
need_sort => $FALSE, # Boolean that says whether the symbol |
|
167
|
|
|
|
|
|
|
# declarations need to be sorted in |
|
168
|
|
|
|
|
|
|
# lexical order. Recording a declaration |
|
169
|
|
|
|
|
|
|
# must set this. Recording a use must |
|
170
|
|
|
|
|
|
|
# clear this, doing the sort if it was |
|
171
|
|
|
|
|
|
|
# previously set. |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
ppix_objects => {}, # Cache of PPIx::QuoteLike and |
|
174
|
|
|
|
|
|
|
# PPIx::Regexp objects indexed by |
|
175
|
|
|
|
|
|
|
# refaddr of parent element. |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
parent_element => {}, # PPI::Element objects from which |
|
178
|
|
|
|
|
|
|
# PPI::Document objects have been |
|
179
|
|
|
|
|
|
|
# derived, indexed by refaddr of derived |
|
180
|
|
|
|
|
|
|
# document. |
|
181
|
|
|
|
|
|
|
}; |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# Ensure entire document is indexed. We don't call index_locations() |
|
184
|
|
|
|
|
|
|
# because that is unconditional. We wrap the whole thing in an eval |
|
185
|
|
|
|
|
|
|
# because last_token() can fail under undiagnosed circumstances. |
|
186
|
|
|
|
|
|
|
{ |
|
187
|
|
|
|
|
|
|
local $EVAL_ERROR = undef; |
|
188
|
|
|
|
|
|
|
eval { ## no critic (RequireCheckingReturnValueOfEval) |
|
189
|
|
|
|
|
|
|
if ( my $token = $document->last_token() ) { |
|
190
|
|
|
|
|
|
|
$token->location(); |
|
191
|
|
|
|
|
|
|
} |
|
192
|
|
|
|
|
|
|
} |
|
193
|
60
|
|
|
|
|
163
|
} |
|
|
60
|
|
|
|
|
159
|
|
|
194
|
60
|
|
|
|
|
169
|
|
|
195
|
60
|
50
|
|
|
|
582
|
$self->_get_symbol_declarations( $document ); |
|
196
|
60
|
|
|
|
|
2421
|
|
|
197
|
|
|
|
|
|
|
$self->_get_symbol_uses( $document ); |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
$self->{_dump} |
|
200
|
|
|
|
|
|
|
and $self->_dump(); |
|
201
|
60
|
|
|
|
|
1143
|
|
|
202
|
|
|
|
|
|
|
return $self->_get_violations(); |
|
203
|
60
|
|
|
|
|
299
|
|
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
|
|
206
|
60
|
50
|
|
|
|
278
|
#----------------------------------------------------------------------------- |
|
207
|
|
|
|
|
|
|
|
|
208
|
60
|
|
|
|
|
242
|
my ( $self ) = @_; |
|
209
|
|
|
|
|
|
|
foreach my $name ( sort keys %{ $self->{$PACKAGE}{declared} } ) { |
|
210
|
|
|
|
|
|
|
# NOTE that 'print { STDERR } ... ' does not compile under |
|
211
|
|
|
|
|
|
|
# strict refs. '{ *STDERR }' is a terser way to satisfy |
|
212
|
|
|
|
|
|
|
# InputOutput::RequireBracedFileHandleWithPrint. |
|
213
|
|
|
|
|
|
|
print { *STDERR } "$name\n"; |
|
214
|
|
|
|
|
|
|
foreach my $decl ( @{ $self->{$PACKAGE}{declared}{$name} } ) { |
|
215
|
0
|
|
|
0
|
|
0
|
my $sym = $decl->{element}; |
|
216
|
0
|
|
|
|
|
0
|
my $fn = $sym->logical_filename(); |
|
|
0
|
|
|
|
|
0
|
|
|
217
|
|
|
|
|
|
|
if ( defined $fn ) { |
|
218
|
|
|
|
|
|
|
$fn =~ s/ (?= [\\'] ) /\\/smxg; |
|
219
|
|
|
|
|
|
|
$fn = "'$fn'"; |
|
220
|
0
|
|
|
|
|
0
|
} else { |
|
|
0
|
|
|
|
|
0
|
|
|
221
|
0
|
|
|
|
|
0
|
$fn = 'undef'; |
|
|
0
|
|
|
|
|
0
|
|
|
222
|
0
|
|
|
|
|
0
|
} |
|
223
|
0
|
|
|
|
|
0
|
printf { *STDERR } |
|
224
|
0
|
0
|
|
|
|
0
|
" %s line %d column %d: used %d; returned %d\n", |
|
225
|
0
|
|
|
|
|
0
|
$fn, |
|
226
|
0
|
|
|
|
|
0
|
$sym->logical_line_number(), |
|
227
|
|
|
|
|
|
|
$sym->column_number(), |
|
228
|
0
|
|
|
|
|
0
|
$decl->{used}, |
|
229
|
|
|
|
|
|
|
$decl->{returned_lexical} || 0, |
|
230
|
0
|
|
|
|
|
0
|
} |
|
231
|
|
|
|
|
|
|
} |
|
232
|
|
|
|
|
|
|
return; |
|
233
|
|
|
|
|
|
|
} |
|
234
|
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
236
|
0
|
|
0
|
|
|
0
|
|
|
237
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
|
238
|
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
0
|
$self->_get_variable_declarations( $document ); |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$self->_get_stray_variable_declarations( $document ); |
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
$self->{_check_catch} |
|
244
|
|
|
|
|
|
|
and $self->_get_catch_declarations( $document ); |
|
245
|
60
|
|
|
60
|
|
309
|
|
|
246
|
|
|
|
|
|
|
return; |
|
247
|
60
|
|
|
|
|
337
|
|
|
248
|
|
|
|
|
|
|
} |
|
249
|
60
|
|
|
|
|
304
|
|
|
250
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
251
|
|
|
|
|
|
|
|
|
252
|
60
|
100
|
|
|
|
304
|
# We assume the argument is actually eligible for this operation. |
|
253
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; |
|
254
|
60
|
|
|
|
|
137
|
return $self->{$PACKAGE}{ppix_objects}{ refaddr $elem } ||= |
|
255
|
|
|
|
|
|
|
PPIx::QuoteLike->new( $elem ); |
|
256
|
|
|
|
|
|
|
} |
|
257
|
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
259
|
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# We assume the argument is actually eligible for this operation. The |
|
261
|
|
|
|
|
|
|
# complication here is that if we are dealing with an element of a |
|
262
|
60
|
|
|
60
|
|
214
|
# Perl::Critic::Document we want to call ppix_regexp_from_element(), |
|
263
|
60
|
|
66
|
|
|
852
|
# since that caches the returned object, making it available to all |
|
264
|
|
|
|
|
|
|
# policies. But the ppi() method returns a PPI::Document, so the best we |
|
265
|
|
|
|
|
|
|
# can do is to cache locally. |
|
266
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; |
|
267
|
|
|
|
|
|
|
return $self->{$PACKAGE}{ppix_objects}{ refaddr $elem } ||= do { |
|
268
|
|
|
|
|
|
|
my $doc = $elem->top(); |
|
269
|
|
|
|
|
|
|
my $code; |
|
270
|
|
|
|
|
|
|
( $code = $doc->can( 'ppix_regexp_from_element' ) ) ? |
|
271
|
|
|
|
|
|
|
$code->( $doc, $elem ) : |
|
272
|
|
|
|
|
|
|
PPIx::Regexp->new( $elem ); |
|
273
|
|
|
|
|
|
|
}; |
|
274
|
|
|
|
|
|
|
} |
|
275
|
|
|
|
|
|
|
|
|
276
|
18
|
|
|
18
|
|
63
|
#----------------------------------------------------------------------------- |
|
277
|
18
|
|
66
|
|
|
241
|
|
|
278
|
9
|
|
|
|
|
83
|
# Get the PPI::Document that represents a PPIx::* class that supports |
|
279
|
9
|
|
|
|
|
152
|
# one. The arguments are: |
|
280
|
9
|
50
|
|
|
|
174
|
# $ppix_elem - the PPIx::* element providing the document. This MUST |
|
281
|
|
|
|
|
|
|
# support the ->ppi() method. |
|
282
|
|
|
|
|
|
|
# $elem - the original PPI::Element from which this element was |
|
283
|
|
|
|
|
|
|
# derived. |
|
284
|
|
|
|
|
|
|
# NOTE that all calls to ->ppi() MUST come through here. |
|
285
|
|
|
|
|
|
|
my ( $self, $ppix_elem, $elem ) = @_; |
|
286
|
|
|
|
|
|
|
my $ppi = $ppix_elem->ppi() |
|
287
|
|
|
|
|
|
|
or return; |
|
288
|
|
|
|
|
|
|
$self->{$PACKAGE}{parent_element}{ refaddr( $ppi ) } ||= $elem; |
|
289
|
|
|
|
|
|
|
return $ppi; |
|
290
|
|
|
|
|
|
|
} |
|
291
|
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# Get the PPI::Element that is the parent of the given PPI::Element, |
|
295
|
|
|
|
|
|
|
# taking into account that the given element may be a derived |
|
296
|
72
|
|
|
72
|
|
281
|
# PPI::Document. |
|
297
|
72
|
50
|
|
|
|
644
|
# NOTE that all calls to PPI::Element->parent() MUST come through here. |
|
298
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; |
|
299
|
72
|
|
66
|
|
|
48793
|
if ( my $parent = $elem->parent() ) { |
|
300
|
72
|
|
|
|
|
323
|
return $parent; |
|
301
|
|
|
|
|
|
|
} else { |
|
302
|
|
|
|
|
|
|
return $self->{$PACKAGE}{parent_element}{ refaddr( $elem ) }; |
|
303
|
|
|
|
|
|
|
} |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
307
|
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# Get the lowest parent of the inner element that is in the same |
|
309
|
|
|
|
|
|
|
# document as the outer element. |
|
310
|
252
|
|
|
252
|
|
542
|
my ( $self, $inner_elem, $outer_elem ) = @_; |
|
311
|
252
|
100
|
|
|
|
768
|
my $outer_top = $outer_elem->top() |
|
312
|
209
|
|
|
|
|
1617
|
or return; |
|
313
|
|
|
|
|
|
|
while ( 1 ) { |
|
314
|
43
|
|
|
|
|
425
|
my $inner_top = $inner_elem->top() |
|
315
|
|
|
|
|
|
|
or last; |
|
316
|
|
|
|
|
|
|
$inner_top == $outer_top |
|
317
|
|
|
|
|
|
|
and return $inner_elem; |
|
318
|
|
|
|
|
|
|
$inner_elem = $self->_get_parent_element( $inner_top ) |
|
319
|
|
|
|
|
|
|
or last; |
|
320
|
|
|
|
|
|
|
} |
|
321
|
|
|
|
|
|
|
return; |
|
322
|
|
|
|
|
|
|
} |
|
323
|
85
|
|
|
85
|
|
205
|
|
|
324
|
85
|
50
|
|
|
|
340
|
#----------------------------------------------------------------------------- |
|
325
|
|
|
|
|
|
|
|
|
326
|
85
|
|
|
|
|
1048
|
my ( $self, $document ) = @_; |
|
327
|
120
|
50
|
|
|
|
336
|
|
|
328
|
|
|
|
|
|
|
my @rslt = @{ $document->find( 'PPI::Statement::Variable' ) || [] }; |
|
329
|
120
|
100
|
|
|
|
1560
|
|
|
330
|
|
|
|
|
|
|
foreach my $class ( @DOUBLE_QUOTISH ) { |
|
331
|
39
|
100
|
|
|
|
448
|
foreach my $elem ( @{ $document->find( $class ) || [] } ) { |
|
332
|
|
|
|
|
|
|
my $str = $self->_get_ppix_quotelike( $elem ) |
|
333
|
|
|
|
|
|
|
or next; |
|
334
|
4
|
|
|
|
|
19
|
foreach my $code ( @{ $str->find( |
|
335
|
|
|
|
|
|
|
'PPIx::QuoteLike::Token::Interpolation' ) || [] } ) { |
|
336
|
|
|
|
|
|
|
my $ppi = $self->_get_derived_ppi_document( $code, $elem ) |
|
337
|
|
|
|
|
|
|
or next; |
|
338
|
|
|
|
|
|
|
push @rslt, $self->_get_ppi_statement_variable( $ppi ); |
|
339
|
|
|
|
|
|
|
} |
|
340
|
96
|
|
|
96
|
|
318
|
} |
|
341
|
|
|
|
|
|
|
} |
|
342
|
96
|
100
|
|
|
|
211
|
|
|
|
96
|
|
|
|
|
414
|
|
|
343
|
|
|
|
|
|
|
foreach my $class ( @REGEXP_ISH ) { |
|
344
|
96
|
|
|
|
|
14987
|
foreach my $elem ( @{ $document->find( $class ) || [] } ) { |
|
345
|
576
|
100
|
|
|
|
49501
|
my $pre = $self->_get_ppix_regexp( $elem ) |
|
|
576
|
|
|
|
|
1437
|
|
|
346
|
30
|
50
|
|
|
|
1051
|
or next; |
|
347
|
|
|
|
|
|
|
foreach my $code ( @{ $pre->find( |
|
348
|
30
|
100
|
|
|
|
42412
|
'PPIx::Regexp::Token::Code' ) || [] } ) { |
|
|
30
|
|
|
|
|
160
|
|
|
349
|
|
|
|
|
|
|
my $ppi = $self->_get_derived_ppi_document( $code, $elem ) |
|
350
|
27
|
50
|
|
|
|
2481
|
or next; |
|
351
|
|
|
|
|
|
|
push @rslt, $self->_get_ppi_statement_variable( $ppi ); |
|
352
|
27
|
|
|
|
|
135
|
} |
|
353
|
|
|
|
|
|
|
} |
|
354
|
|
|
|
|
|
|
} |
|
355
|
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
return @rslt; |
|
357
|
96
|
|
|
|
|
9492
|
} |
|
358
|
288
|
100
|
|
|
|
18757
|
|
|
|
288
|
|
|
|
|
733
|
|
|
359
|
9
|
50
|
|
|
|
807
|
#----------------------------------------------------------------------------- |
|
360
|
|
|
|
|
|
|
|
|
361
|
9
|
50
|
|
|
|
91267
|
# The catch() clause of try/catch is a special case because the 'my' is |
|
|
9
|
|
|
|
|
52
|
|
|
362
|
|
|
|
|
|
|
# implied. Also the syntax requires you to specify a variable even if |
|
363
|
9
|
50
|
|
|
|
2607
|
# you have no intention of using it. |
|
364
|
|
|
|
|
|
|
# NOTE that we assume that if we get called, the check is to be done. |
|
365
|
9
|
|
|
|
|
44
|
my ( $self, $document ) = @_; |
|
366
|
|
|
|
|
|
|
foreach my $word ( @{ $document->find( 'PPI::Token::Word' ) || [] } ) { |
|
367
|
|
|
|
|
|
|
$CATCH eq $word->content() |
|
368
|
|
|
|
|
|
|
or next; |
|
369
|
|
|
|
|
|
|
my $list = $word->snext_sibling() |
|
370
|
96
|
|
|
|
|
9869
|
or next; |
|
371
|
|
|
|
|
|
|
$list->isa( 'PPI::Structure::List' ) |
|
372
|
|
|
|
|
|
|
or next; |
|
373
|
|
|
|
|
|
|
my $block = $list->snext_sibling() |
|
374
|
|
|
|
|
|
|
or next; |
|
375
|
|
|
|
|
|
|
$block->isa( 'PPI::Structure::Block' ) |
|
376
|
|
|
|
|
|
|
or next; |
|
377
|
|
|
|
|
|
|
foreach my $sym ( @{ $list->find( 'PPI::Token::Symbol' ) || [] } ) { |
|
378
|
|
|
|
|
|
|
# Should be only one, but ... |
|
379
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
|
380
|
2
|
|
|
2
|
|
7
|
$sym, $sym->statement() ); |
|
381
|
2
|
50
|
|
|
|
6
|
} |
|
|
2
|
|
|
|
|
9
|
|
|
382
|
7
|
100
|
|
|
|
51
|
} |
|
383
|
|
|
|
|
|
|
return; |
|
384
|
2
|
50
|
|
|
|
17
|
} |
|
385
|
|
|
|
|
|
|
|
|
386
|
2
|
50
|
|
|
|
91
|
#----------------------------------------------------------------------------- |
|
387
|
|
|
|
|
|
|
|
|
388
|
2
|
50
|
|
|
|
20
|
# Sorry, but this is just basicly hard. |
|
389
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
|
390
|
2
|
50
|
|
|
|
59
|
|
|
391
|
|
|
|
|
|
|
foreach my $declaration ( $self->_get_ppi_statement_variable( $document ) ) { |
|
392
|
2
|
50
|
|
|
|
6
|
|
|
|
2
|
|
|
|
|
11
|
|
|
393
|
|
|
|
|
|
|
# This _should_ be the initial 'my', 'our' 'state' |
|
394
|
2
|
|
|
|
|
799
|
my $elem = $declaration->schild( 0 ) |
|
395
|
|
|
|
|
|
|
or next; |
|
396
|
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
my $is_unpacking = $declaration->content() =~ m< |
|
398
|
2
|
|
|
|
|
10
|
= \s* (?: \@_ | |
|
399
|
|
|
|
|
|
|
shift (?: \s* \@_ )? ) | |
|
400
|
|
|
|
|
|
|
\$_ [[] .*? []] |
|
401
|
|
|
|
|
|
|
\s* ;? \z >smx; |
|
402
|
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
my $taking_reference = $self->_taking_reference_of_variable( |
|
404
|
|
|
|
|
|
|
$declaration ); |
|
405
|
60
|
|
|
60
|
|
184
|
|
|
406
|
|
|
|
|
|
|
my $returned_lexical = $self->_returned_lexical( $declaration ); |
|
407
|
60
|
|
|
|
|
260
|
|
|
408
|
|
|
|
|
|
|
while ( 1 ) { |
|
409
|
|
|
|
|
|
|
|
|
410
|
100
|
50
|
|
|
|
1453
|
# Looking for 'my', 'our', or 'state' |
|
411
|
|
|
|
|
|
|
$elem->isa( 'PPI::Token::Word' ) |
|
412
|
|
|
|
|
|
|
or next; |
|
413
|
100
|
|
|
|
|
1634
|
defined( my $is_global = $GLOBAL_DECLARATION{ |
|
414
|
|
|
|
|
|
|
$elem->content()} ) |
|
415
|
|
|
|
|
|
|
or next; |
|
416
|
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
$elem = $elem->snext_sibling() |
|
418
|
|
|
|
|
|
|
or last; |
|
419
|
100
|
|
|
|
|
5348
|
|
|
420
|
|
|
|
|
|
|
# We can't just look for symbols, since PPI parses the |
|
421
|
|
|
|
|
|
|
# parens in |
|
422
|
100
|
|
|
|
|
565
|
# open( my $fh, '>&', \*STDOUT ) |
|
423
|
|
|
|
|
|
|
# as a PPI::Statement::Variable, and we get a false positive |
|
424
|
100
|
|
|
|
|
1011
|
# on STDOUT. |
|
425
|
|
|
|
|
|
|
my @symbol_list; |
|
426
|
|
|
|
|
|
|
if ( $elem->isa( 'PPI::Token::Symbol' ) ) { |
|
427
|
386
|
100
|
|
|
|
6614
|
push @symbol_list, $elem; |
|
428
|
|
|
|
|
|
|
} elsif ( $elem->isa( 'PPI::Structure::List' ) ) { |
|
429
|
|
|
|
|
|
|
push @symbol_list, @{ |
|
430
|
120
|
100
|
|
|
|
330
|
$elem->find( 'PPI::Token::Symbol' ) || [] }; |
|
431
|
|
|
|
|
|
|
} else { |
|
432
|
|
|
|
|
|
|
next; |
|
433
|
102
|
100
|
|
|
|
1512
|
} |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
my ( $assign, $is_allowed_computation, |
|
436
|
|
|
|
|
|
|
$is_state_in_expression ) = |
|
437
|
|
|
|
|
|
|
$self->_get_allowed_and_state( $elem, $declaration ); |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
foreach my $symbol ( @symbol_list ) { |
|
440
|
|
|
|
|
|
|
|
|
441
|
100
|
|
|
|
|
2545
|
if ( $assign ) { |
|
442
|
100
|
100
|
|
|
|
346
|
$symbol->logical_line_number() < |
|
|
|
50
|
|
|
|
|
|
|
443
|
91
|
|
|
|
|
199
|
$assign->logical_line_number() |
|
444
|
|
|
|
|
|
|
or $symbol->logical_line_number() == |
|
445
|
|
|
|
|
|
|
$assign->logical_line_number() |
|
446
|
9
|
50
|
|
|
|
148
|
and $symbol->column_number() < $assign->column_number() |
|
|
9
|
|
|
|
|
34
|
|
|
447
|
|
|
|
|
|
|
or next; |
|
448
|
0
|
|
|
|
|
0
|
} |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
|
451
|
100
|
|
|
|
|
3402
|
$symbol, $declaration, |
|
452
|
|
|
|
|
|
|
is_allowed_computation => $is_allowed_computation, |
|
453
|
|
|
|
|
|
|
is_global => $is_global, |
|
454
|
|
|
|
|
|
|
is_state_in_expression => $is_state_in_expression, |
|
455
|
100
|
|
|
|
|
266
|
is_unpacking => $is_unpacking, |
|
456
|
|
|
|
|
|
|
taking_reference => $taking_reference, |
|
457
|
107
|
100
|
|
|
|
300
|
returned_lexical => $returned_lexical, |
|
458
|
86
|
50
|
33
|
|
|
275
|
); |
|
|
|
|
33
|
|
|
|
|
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
} |
|
461
|
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
} continue { |
|
463
|
|
|
|
|
|
|
$elem |
|
464
|
|
|
|
|
|
|
and $elem = $elem->snext_sibling() |
|
465
|
|
|
|
|
|
|
or last; |
|
466
|
|
|
|
|
|
|
} |
|
467
|
107
|
|
|
|
|
6311
|
|
|
468
|
|
|
|
|
|
|
} |
|
469
|
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
return; |
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# FIXME this is a God-awful mish-mash forced on me by the fact that PPI |
|
474
|
|
|
|
|
|
|
# does not in fact parse all variable declarations as |
|
475
|
|
|
|
|
|
|
# PPI::Statement::Variable objects, so this code needs to be shared |
|
476
|
|
|
|
|
|
|
# among multiple code paths. The arguments are: |
|
477
|
|
|
|
|
|
|
# $self |
|
478
|
|
|
|
|
|
|
# $elem - the relevant element of the statement |
|
479
|
384
|
100
|
66
|
|
|
2072
|
# $declaration - the statement that declares the variable |
|
480
|
|
|
|
|
|
|
# $type - 'my', 'our', 'state'. Forbidden (but not enforcded) if |
|
481
|
|
|
|
|
|
|
# $declaration isa PPI::Statement::Variable, otherwise required. |
|
482
|
|
|
|
|
|
|
my ( $self, $elem, $declaration, $type ) = @_; |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
my ( $assign, $is_allowed_computation, |
|
485
|
|
|
|
|
|
|
$is_state_in_expression ); |
|
486
|
60
|
|
|
|
|
1185
|
|
|
487
|
|
|
|
|
|
|
while ( $elem = $elem->snext_sibling() ) { |
|
488
|
|
|
|
|
|
|
$elem->isa( 'PPI::Token::Operator' ) |
|
489
|
|
|
|
|
|
|
or next; |
|
490
|
|
|
|
|
|
|
my $content = $elem->content(); |
|
491
|
|
|
|
|
|
|
$IS_COMMA{$content} |
|
492
|
|
|
|
|
|
|
and last; |
|
493
|
|
|
|
|
|
|
if ( $EQUAL eq $content ) { |
|
494
|
|
|
|
|
|
|
$assign = $elem; |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
$is_allowed_computation = $self->_is_allowed_computation( |
|
497
|
|
|
|
|
|
|
$assign ); |
|
498
|
|
|
|
|
|
|
|
|
499
|
109
|
|
|
109
|
|
299
|
$is_state_in_expression = $self->_is_state_in_expression( |
|
500
|
|
|
|
|
|
|
$declaration, $assign, $type ); |
|
501
|
109
|
|
|
|
|
198
|
|
|
502
|
|
|
|
|
|
|
last; |
|
503
|
|
|
|
|
|
|
} elsif ( $IS_INC_DEC{$content} ) { |
|
504
|
109
|
|
|
|
|
334
|
$is_state_in_expression = 1; |
|
505
|
114
|
100
|
|
|
|
2726
|
last; |
|
506
|
|
|
|
|
|
|
} |
|
507
|
96
|
|
|
|
|
248
|
} |
|
508
|
96
|
100
|
|
|
|
595
|
|
|
509
|
|
|
|
|
|
|
return ( $assign, $is_allowed_computation, $is_state_in_expression ); |
|
510
|
90
|
100
|
|
|
|
756
|
} |
|
|
|
100
|
|
|
|
|
|
|
511
|
84
|
|
|
|
|
162
|
|
|
512
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
513
|
84
|
|
|
|
|
329
|
|
|
514
|
|
|
|
|
|
|
{ |
|
515
|
|
|
|
|
|
|
|
|
516
|
84
|
|
|
|
|
285
|
Readonly::Hash my %IS_FOR => hashify( qw{ for foreach } ); |
|
517
|
|
|
|
|
|
|
Readonly::Hash my %IS_RETURN => hashify( qw{ return } ); |
|
518
|
|
|
|
|
|
|
|
|
519
|
84
|
|
|
|
|
221
|
# Get stray declarations that do not show up in |
|
520
|
|
|
|
|
|
|
# PPI::Statement::Variable statements. These show up in |
|
521
|
4
|
|
|
|
|
29
|
# PPI::Statement::Compound (specifically 'for' and 'foreach'), and |
|
522
|
4
|
|
|
|
|
12
|
# in PPI::Statement::Break (specifically 'return'). In the case of |
|
523
|
|
|
|
|
|
|
# 'return', we do not need to descend into paren, because if there |
|
524
|
|
|
|
|
|
|
# are parens, PPI produces a PPI::Statement::Variable. |
|
525
|
|
|
|
|
|
|
|
|
526
|
109
|
|
|
|
|
825
|
my ( $self, $document ) = @_; |
|
527
|
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
foreach ( |
|
529
|
|
|
|
|
|
|
[ 'PPI::Statement::Compound' => { |
|
530
|
|
|
|
|
|
|
want => \%IS_FOR, |
|
531
|
|
|
|
|
|
|
returned_lexical => $FALSE, |
|
532
|
|
|
|
|
|
|
} ], |
|
533
|
|
|
|
|
|
|
[ 'PPI::Statement::Break' => { |
|
534
|
|
|
|
|
|
|
want => \%IS_RETURN, |
|
535
|
|
|
|
|
|
|
returned_lexical => $TRUE, |
|
536
|
|
|
|
|
|
|
} ], |
|
537
|
|
|
|
|
|
|
) { |
|
538
|
|
|
|
|
|
|
my ( $class, $info ) = @{ $_ }; |
|
539
|
|
|
|
|
|
|
foreach my $declaration ( |
|
540
|
|
|
|
|
|
|
@{ $document->find( $class ) || [] } |
|
541
|
|
|
|
|
|
|
) { |
|
542
|
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
my $type = $declaration->schild( 0 ) |
|
544
|
60
|
|
|
60
|
|
151
|
or next; |
|
545
|
|
|
|
|
|
|
|
|
546
|
60
|
|
|
|
|
534
|
my $type_str = $type->content(); |
|
547
|
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
if ( $info->{want}{$type_str} ) { |
|
549
|
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
my $sib = $type->snext_sibling() |
|
551
|
|
|
|
|
|
|
or next; |
|
552
|
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
# We're looking for 'my', 'state', or 'our'. |
|
554
|
|
|
|
|
|
|
$sib->isa( 'PPI::Token::Word' ) |
|
555
|
|
|
|
|
|
|
or next; |
|
556
|
120
|
|
|
|
|
944
|
my $sib_content = $sib->content(); |
|
|
120
|
|
|
|
|
342
|
|
|
557
|
120
|
|
|
|
|
233
|
defined( my $is_global = $GLOBAL_DECLARATION{$sib_content} ) |
|
558
|
120
|
100
|
|
|
|
522
|
or next; |
|
559
|
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
my $symbol = $sib->snext_sibling() |
|
561
|
25
|
50
|
|
|
|
299
|
or next; |
|
562
|
|
|
|
|
|
|
$symbol->isa( 'PPI::Token::Symbol' ) |
|
563
|
|
|
|
|
|
|
or next; |
|
564
|
25
|
|
|
|
|
355
|
|
|
565
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
|
566
|
25
|
100
|
|
|
|
981
|
$symbol, $declaration, |
|
567
|
|
|
|
|
|
|
is_global => $is_global, |
|
568
|
13
|
50
|
|
|
|
94
|
returned_lexical => $info->{returned_lexical}, |
|
569
|
|
|
|
|
|
|
); |
|
570
|
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
} |
|
572
|
13
|
100
|
|
|
|
292
|
|
|
573
|
|
|
|
|
|
|
} |
|
574
|
8
|
|
|
|
|
37
|
|
|
575
|
8
|
50
|
|
|
|
53
|
} |
|
576
|
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
return; |
|
578
|
8
|
50
|
|
|
|
65
|
} |
|
579
|
|
|
|
|
|
|
|
|
580
|
8
|
50
|
|
|
|
179
|
} |
|
581
|
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
583
|
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; # $elem presumed to be '='. |
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
my $next_sib = $elem->snext_sibling() or return; |
|
587
|
8
|
|
|
|
|
27
|
|
|
588
|
|
|
|
|
|
|
if ( $next_sib->isa( 'PPI::Token::Word' ) ) { |
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# We are presumed to be a subroutine call. |
|
591
|
|
|
|
|
|
|
my $content = $next_sib->content(); |
|
592
|
|
|
|
|
|
|
$self->{_allow_if_computed_by}{$content} |
|
593
|
|
|
|
|
|
|
and return $content; |
|
594
|
|
|
|
|
|
|
|
|
595
|
60
|
|
|
|
|
733
|
} elsif ( $next_sib->isa( 'PPI::Token::Symbol' ) ) { |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# We might be a method call. |
|
598
|
|
|
|
|
|
|
$next_sib = $next_sib->snext_sibling() |
|
599
|
|
|
|
|
|
|
or return; |
|
600
|
|
|
|
|
|
|
$next_sib->isa( 'PPI::Token::Operator' ) |
|
601
|
|
|
|
|
|
|
and q{->} eq $next_sib->content() |
|
602
|
|
|
|
|
|
|
or return; |
|
603
|
84
|
|
|
84
|
|
196
|
$next_sib = $next_sib->snext_sibling() |
|
604
|
|
|
|
|
|
|
or return; |
|
605
|
84
|
50
|
|
|
|
230
|
my $content = $next_sib->content(); |
|
606
|
|
|
|
|
|
|
$self->{_allow_if_computed_by}{$content} |
|
607
|
84
|
100
|
|
|
|
2394
|
and return $content; |
|
|
|
100
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
} |
|
609
|
|
|
|
|
|
|
|
|
610
|
12
|
|
|
|
|
33
|
return; |
|
611
|
12
|
100
|
|
|
|
86
|
} |
|
612
|
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# Find cases where the value of a state variable is used by the |
|
616
|
|
|
|
|
|
|
# statement that declares it, or an expression in which that statement |
|
617
|
8
|
50
|
|
|
|
33
|
# appears. The user may wish to accept such variables even if the |
|
618
|
|
|
|
|
|
|
# variable itself appears only in the statement that declares it. |
|
619
|
8
|
50
|
33
|
|
|
204
|
# |
|
620
|
|
|
|
|
|
|
# $declaration is assumed to be a PPI::Statement::Variable. We return |
|
621
|
|
|
|
|
|
|
# $FALSE unless it declares state variables. |
|
622
|
0
|
0
|
|
|
|
0
|
# |
|
623
|
|
|
|
|
|
|
# $operator is the first assignment operator in $declaration. |
|
624
|
0
|
|
|
|
|
0
|
# |
|
625
|
0
|
0
|
|
|
|
0
|
# NOTE that this will never be called for stuff like |
|
626
|
|
|
|
|
|
|
# $foo and state $bar = 42 |
|
627
|
|
|
|
|
|
|
# because PPI does not parse this as a PPI::Statement::Variable. |
|
628
|
|
|
|
|
|
|
my ( $self, $declaration, $operator, $type ) = @_; |
|
629
|
75
|
|
|
|
|
225
|
|
|
630
|
|
|
|
|
|
|
unless ( defined $type ) { ## no critic (ProhibitUnlessBlocks) |
|
631
|
|
|
|
|
|
|
$declaration->can( 'type' ) |
|
632
|
|
|
|
|
|
|
or throw_internal |
|
633
|
|
|
|
|
|
|
'BUG - $type required if $declaration->type() does not exist'; ## no critic (RequireInterpolationOfMetachars) |
|
634
|
|
|
|
|
|
|
$type = $declaration->type(); |
|
635
|
|
|
|
|
|
|
} |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# We're only interested in state declarations. |
|
638
|
|
|
|
|
|
|
q<state> eq $type |
|
639
|
|
|
|
|
|
|
or return $FALSE; |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# We accept things like |
|
642
|
|
|
|
|
|
|
# state $foo = bar() and ... |
|
643
|
|
|
|
|
|
|
my $next_sib = $operator; |
|
644
|
|
|
|
|
|
|
while ( $next_sib = $next_sib->snext_sibling() ) { |
|
645
|
|
|
|
|
|
|
$next_sib->isa( 'PPI::Token::Operator' ) |
|
646
|
|
|
|
|
|
|
and $LOW_PRECEDENCE_BOOLEAN{ $next_sib->content() } |
|
647
|
|
|
|
|
|
|
and return $TRUE; |
|
648
|
84
|
|
|
84
|
|
220
|
} |
|
649
|
|
|
|
|
|
|
|
|
650
|
84
|
100
|
|
|
|
239
|
# We accept things like |
|
651
|
82
|
50
|
|
|
|
324
|
# ... ( state $foo = bar() ) ... |
|
652
|
|
|
|
|
|
|
# IF at least one of the ellipses has an operator adjacent to our |
|
653
|
|
|
|
|
|
|
# declaration. |
|
654
|
82
|
|
|
|
|
282
|
my $elem = $declaration; |
|
655
|
|
|
|
|
|
|
while ( $elem ) { |
|
656
|
|
|
|
|
|
|
foreach my $method ( qw{ snext_sibling sprevious_sibling } ) { |
|
657
|
|
|
|
|
|
|
my $sib = $elem->$method() |
|
658
|
84
|
100
|
|
|
|
3302
|
or next; |
|
659
|
|
|
|
|
|
|
$sib->isa( 'PPI::Token::Operator' ) |
|
660
|
|
|
|
|
|
|
and return $TRUE; |
|
661
|
|
|
|
|
|
|
} |
|
662
|
|
|
|
|
|
|
$elem = $self->_get_parent_element( $elem ); |
|
663
|
7
|
|
|
|
|
20
|
} |
|
664
|
7
|
|
|
|
|
23
|
|
|
665
|
|
|
|
|
|
|
# There are no other known cases where a state variable's value can |
|
666
|
14
|
100
|
66
|
|
|
362
|
# be used without the variable name appearing anywhere other than |
|
667
|
|
|
|
|
|
|
# its initialization. |
|
668
|
|
|
|
|
|
|
return $FALSE; |
|
669
|
|
|
|
|
|
|
} |
|
670
|
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; # Expect a PPI::Statement::Variable |
|
674
|
5
|
|
|
|
|
116
|
my $parent = $self->_get_parent_element( $elem ) |
|
675
|
5
|
|
|
|
|
22
|
or return; |
|
676
|
14
|
|
|
|
|
36
|
my $cast; |
|
677
|
27
|
100
|
|
|
|
229
|
|
|
678
|
|
|
|
|
|
|
if ( $parent->isa( 'PPI::Structure::List' ) ) { |
|
679
|
9
|
100
|
|
|
|
284
|
|
|
680
|
|
|
|
|
|
|
$cast = $parent->sprevious_sibling() |
|
681
|
|
|
|
|
|
|
or return; |
|
682
|
13
|
|
|
|
|
143
|
|
|
683
|
|
|
|
|
|
|
} elsif ( $parent->isa( 'PPI::Structure::Block' ) ) { |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
my $prev = $parent->sprevious_sibling() |
|
686
|
|
|
|
|
|
|
or return; |
|
687
|
|
|
|
|
|
|
|
|
688
|
4
|
|
|
|
|
14
|
$prev->isa( 'PPI::Token::Word' ) |
|
689
|
|
|
|
|
|
|
or return; |
|
690
|
|
|
|
|
|
|
'do' eq $prev->content() |
|
691
|
|
|
|
|
|
|
or return; |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
$cast = $prev->sprevious_sibling() |
|
694
|
100
|
|
|
100
|
|
244
|
|
|
695
|
100
|
50
|
|
|
|
315
|
} |
|
696
|
|
|
|
|
|
|
|
|
697
|
100
|
|
|
|
|
226
|
$cast |
|
698
|
|
|
|
|
|
|
or return; |
|
699
|
100
|
100
|
|
|
|
607
|
$cast->isa( 'PPI::Token::Cast' ) |
|
|
|
100
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
or return; |
|
701
|
12
|
100
|
|
|
|
127
|
return q<\\> eq $cast->content() |
|
702
|
|
|
|
|
|
|
} |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
705
|
|
|
|
|
|
|
|
|
706
|
23
|
100
|
|
|
|
84
|
my ( $self, $elem ) = @_; # Expect a PPI::Statement::Variable |
|
707
|
|
|
|
|
|
|
my $parent = $self->_get_parent_element( $elem ) |
|
708
|
|
|
|
|
|
|
or return; |
|
709
|
14
|
100
|
|
|
|
445
|
my $stmt = $parent->statement() |
|
710
|
|
|
|
|
|
|
or return; |
|
711
|
13
|
100
|
|
|
|
38
|
$stmt->isa( 'PPI::Statement::Break' ) |
|
712
|
|
|
|
|
|
|
or return; |
|
713
|
|
|
|
|
|
|
my $kind = $stmt->schild( 0 ) |
|
714
|
4
|
|
|
|
|
53
|
or return; # Should never happen. |
|
715
|
|
|
|
|
|
|
return 'return' eq $kind->content(); |
|
716
|
|
|
|
|
|
|
} |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
719
|
80
|
100
|
|
|
|
612
|
|
|
720
|
13
|
100
|
|
|
|
71
|
{ |
|
721
|
|
|
|
|
|
|
|
|
722
|
6
|
|
|
|
|
19
|
Readonly::Hash my %CAST_FOR_BARE_BRACKETED_VARIABLE => qw{ |
|
723
|
|
|
|
|
|
|
@ @ |
|
724
|
|
|
|
|
|
|
$ $ |
|
725
|
|
|
|
|
|
|
$$ $ |
|
726
|
|
|
|
|
|
|
% % |
|
727
|
|
|
|
|
|
|
}; |
|
728
|
100
|
|
|
100
|
|
250
|
|
|
729
|
100
|
50
|
|
|
|
241
|
my ( $self, $document ) = @_; |
|
730
|
|
|
|
|
|
|
|
|
731
|
100
|
100
|
|
|
|
413
|
foreach my $symbol ( |
|
732
|
|
|
|
|
|
|
@{ $document->find( 'PPI::Token::Symbol' ) || [] } |
|
733
|
36
|
100
|
|
|
|
752
|
) { |
|
734
|
|
|
|
|
|
|
$self->{$PACKAGE}{is_declaration}->{ refaddr( $symbol ) } and next; |
|
735
|
4
|
50
|
|
|
|
14
|
|
|
736
|
|
|
|
|
|
|
$self->_record_symbol_use( $document, $symbol ); |
|
737
|
4
|
|
|
|
|
51
|
|
|
738
|
|
|
|
|
|
|
} |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
# For some reason, PPI parses '$#foo' as a |
|
741
|
|
|
|
|
|
|
# PPI::Token::ArrayIndex. $#$foo is parsed as a Cast followed |
|
742
|
|
|
|
|
|
|
# by a Symbol, so as long as nobody decides the '$#' cast causes |
|
743
|
|
|
|
|
|
|
# $elem->symbol() to return something other than '$foo', we're |
|
744
|
|
|
|
|
|
|
# cool. |
|
745
|
|
|
|
|
|
|
foreach my $elem ( |
|
746
|
|
|
|
|
|
|
@{ $document->find( 'PPI::Token::ArrayIndex' ) || [] } |
|
747
|
|
|
|
|
|
|
) { |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
my $name = $elem->content(); |
|
750
|
|
|
|
|
|
|
$name =~ s/ \A \$ [#] /@/smx or next; |
|
751
|
|
|
|
|
|
|
|
|
752
|
99
|
|
|
99
|
|
333
|
$self->_record_symbol_use( $document, $elem, $name ); |
|
753
|
|
|
|
|
|
|
} |
|
754
|
99
|
|
|
|
|
213
|
|
|
755
|
99
|
100
|
|
|
|
383
|
# Occasionally you see something like ${foo} outside quotes. |
|
756
|
|
|
|
|
|
|
# This is legitimate, though PPI parses it as a cast followed by |
|
757
|
215
|
100
|
|
|
|
12556
|
# a block. On the assumption that there are fewer blocks than |
|
758
|
|
|
|
|
|
|
# words in most Perl, we start at the top and work down. Perl |
|
759
|
98
|
|
|
|
|
485
|
# also handles punctuation variables specified this way, but |
|
760
|
|
|
|
|
|
|
# since PPI goes berserk when it sees this, we won't bother. |
|
761
|
|
|
|
|
|
|
# |
|
762
|
|
|
|
|
|
|
# And EXTREMELY occasionally something like $${foo} gets parsed |
|
763
|
|
|
|
|
|
|
# as magic followed by subscript. |
|
764
|
|
|
|
|
|
|
foreach my $class ( qw{ |
|
765
|
|
|
|
|
|
|
PPI::Structure::Block |
|
766
|
|
|
|
|
|
|
PPI::Structure::Subscript |
|
767
|
|
|
|
|
|
|
} |
|
768
|
99
|
|
|
|
|
756
|
) { |
|
769
|
99
|
100
|
|
|
|
392
|
foreach my $elem ( |
|
770
|
|
|
|
|
|
|
@{ $document->find( $class ) || [] } |
|
771
|
|
|
|
|
|
|
) { |
|
772
|
1
|
|
|
|
|
17
|
$LEFT_BRACE eq $elem->start() # Only needed for subscript. |
|
773
|
1
|
50
|
|
|
|
10
|
or next; |
|
774
|
|
|
|
|
|
|
my $previous = $elem->sprevious_sibling() |
|
775
|
1
|
|
|
|
|
5
|
or next; |
|
776
|
|
|
|
|
|
|
$previous->isa( 'PPI::Token::Cast' ) |
|
777
|
|
|
|
|
|
|
or $previous->isa( 'PPI::Token::Magic' ) # $${foo} |
|
778
|
|
|
|
|
|
|
or next; |
|
779
|
|
|
|
|
|
|
my $sigil = $CAST_FOR_BARE_BRACKETED_VARIABLE{ |
|
780
|
|
|
|
|
|
|
$previous->content() } |
|
781
|
|
|
|
|
|
|
or next; |
|
782
|
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
my @kids = $elem->schildren(); |
|
784
|
|
|
|
|
|
|
1 == @kids |
|
785
|
|
|
|
|
|
|
or next; |
|
786
|
|
|
|
|
|
|
$kids[0]->isa( 'PPI::Statement' ) |
|
787
|
99
|
|
|
|
|
10571
|
or next; |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
my @grand_kids = $kids[0]->schildren(); |
|
790
|
|
|
|
|
|
|
1 == @grand_kids |
|
791
|
|
|
|
|
|
|
or next; |
|
792
|
198
|
|
|
|
|
9294
|
|
|
793
|
198
|
100
|
|
|
|
512
|
# Yes, "${v6}_..." occurred, and was parsed as a |
|
794
|
|
|
|
|
|
|
# PPI::Token::Number::Version by PPI 1.270. |
|
795
|
62
|
100
|
|
|
|
3697
|
$grand_kids[0]->isa( 'PPI::Token::Word' ) |
|
796
|
|
|
|
|
|
|
or $grand_kids[0]->isa( 'PPI::Token::Number::Version' ) |
|
797
|
54
|
100
|
|
|
|
1215
|
or next; |
|
798
|
|
|
|
|
|
|
|
|
799
|
44
|
100
|
66
|
|
|
1467
|
$self->_record_symbol_use( $document, $elem, |
|
800
|
|
|
|
|
|
|
$sigil . $grand_kids[0]->content(), |
|
801
|
|
|
|
|
|
|
); |
|
802
|
|
|
|
|
|
|
} |
|
803
|
4
|
50
|
|
|
|
14
|
} |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
$self->_get_regexp_symbol_uses( $document ); |
|
806
|
4
|
|
|
|
|
82
|
|
|
807
|
4
|
50
|
|
|
|
68
|
$self->_get_double_quotish_string_uses( $document ); |
|
808
|
|
|
|
|
|
|
|
|
809
|
4
|
50
|
|
|
|
25
|
$self->_get_subroutine_signature_uses( $document ); |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
return; |
|
812
|
4
|
|
|
|
|
16
|
} |
|
813
|
4
|
50
|
|
|
|
34
|
|
|
814
|
|
|
|
|
|
|
} |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
817
|
|
|
|
|
|
|
|
|
818
|
4
|
100
|
66
|
|
|
46
|
# Record the definition of a symbol. |
|
819
|
|
|
|
|
|
|
# $symbol is the PPI::Token::Symbol |
|
820
|
|
|
|
|
|
|
# $declaration is the statement that declares it |
|
821
|
|
|
|
|
|
|
# %arg is optional arguments, collected and recorded to support the |
|
822
|
1
|
|
|
|
|
15
|
# various configuration items. |
|
823
|
|
|
|
|
|
|
my ( $self, $symbol, $declaration, %arg ) = @_; |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
my $ref_addr = refaddr( $symbol ); |
|
826
|
|
|
|
|
|
|
my $sym_name = $symbol->symbol(); |
|
827
|
|
|
|
|
|
|
|
|
828
|
99
|
|
|
|
|
7086
|
$self->{$PACKAGE}{is_declaration}{$ref_addr} = 1; |
|
829
|
|
|
|
|
|
|
|
|
830
|
99
|
|
|
|
|
530
|
$arg{declaration} = $declaration; |
|
831
|
|
|
|
|
|
|
$arg{element} = $symbol; |
|
832
|
99
|
|
|
|
|
490
|
$arg{used} = 0; |
|
833
|
|
|
|
|
|
|
|
|
834
|
99
|
|
|
|
|
364
|
foreach my $key ( qw{ |
|
835
|
|
|
|
|
|
|
is_allowed_computation |
|
836
|
|
|
|
|
|
|
is_global |
|
837
|
|
|
|
|
|
|
is_state_in_expression |
|
838
|
|
|
|
|
|
|
is_unpacking |
|
839
|
|
|
|
|
|
|
taking_reference |
|
840
|
|
|
|
|
|
|
returned_lexical |
|
841
|
|
|
|
|
|
|
} ) { |
|
842
|
|
|
|
|
|
|
exists $arg{$key} |
|
843
|
|
|
|
|
|
|
or $arg{$key} = $FALSE; |
|
844
|
|
|
|
|
|
|
} |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
if ( $self->{_trace}{$sym_name} ) { |
|
847
|
126
|
|
|
126
|
|
808
|
printf { *STDERR } |
|
848
|
|
|
|
|
|
|
"%s 0x%x declared at line %d col %d\n", |
|
849
|
126
|
|
|
|
|
398
|
$sym_name, $ref_addr, |
|
850
|
126
|
|
|
|
|
498
|
$symbol->logical_line_number(), $symbol->column_number(); |
|
851
|
|
|
|
|
|
|
} |
|
852
|
126
|
|
|
|
|
6209
|
|
|
853
|
|
|
|
|
|
|
push @{ $self->{$PACKAGE}{declared}{ $sym_name } ||= [] }, \%arg; |
|
854
|
126
|
|
|
|
|
363
|
|
|
855
|
126
|
|
|
|
|
382
|
$self->{$PACKAGE}{need_sort} = $TRUE; |
|
856
|
126
|
|
|
|
|
306
|
|
|
857
|
|
|
|
|
|
|
return; |
|
858
|
126
|
|
|
|
|
337
|
} |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
my ( $self, undef, $symbol, $symbol_name ) = @_; # $document not used |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
my $declaration; |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
defined $symbol_name |
|
867
|
756
|
100
|
|
|
|
1623
|
or $symbol_name = $symbol->symbol(); |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
if ( ! ( $declaration = $self->{$PACKAGE}{declared}{$symbol_name} ) ) { |
|
870
|
126
|
50
|
|
|
|
373
|
# If we did not find a declaration for the symbol, it may |
|
871
|
0
|
|
|
|
|
0
|
# have been declared en passant, as part of doing something |
|
|
0
|
|
|
|
|
0
|
|
|
872
|
|
|
|
|
|
|
# else. |
|
873
|
|
|
|
|
|
|
my $prev = $symbol->sprevious_sibling() |
|
874
|
|
|
|
|
|
|
or return; |
|
875
|
|
|
|
|
|
|
$prev->isa( 'PPI::Token::Word' ) |
|
876
|
|
|
|
|
|
|
or return; |
|
877
|
126
|
|
100
|
|
|
207
|
my $type = $prev->content(); |
|
|
126
|
|
|
|
|
681
|
|
|
878
|
|
|
|
|
|
|
exists $GLOBAL_DECLARATION{$type} |
|
879
|
126
|
|
|
|
|
326
|
or return; |
|
880
|
|
|
|
|
|
|
|
|
881
|
126
|
|
|
|
|
364
|
# Yup. It's a declaration. Record it. |
|
882
|
|
|
|
|
|
|
$declaration = $symbol->statement(); |
|
883
|
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
my $cast = $prev->sprevious_sibling(); |
|
885
|
|
|
|
|
|
|
if ( ! $cast ) { |
|
886
|
|
|
|
|
|
|
my $parent; |
|
887
|
100
|
|
|
100
|
|
317
|
$parent = $self->_get_parent_element( $prev ) |
|
888
|
|
|
|
|
|
|
and $cast = $parent->sprevious_sibling(); |
|
889
|
100
|
|
|
|
|
181
|
} |
|
890
|
|
|
|
|
|
|
|
|
891
|
100
|
100
|
|
|
|
470
|
my ( undef, $is_allowed_computation, |
|
892
|
|
|
|
|
|
|
$is_state_in_expression ) = |
|
893
|
|
|
|
|
|
|
$self->_get_allowed_and_state( $symbol, $declaration, |
|
894
|
100
|
100
|
|
|
|
5905
|
$type ); |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
|
897
|
|
|
|
|
|
|
$symbol, $declaration, |
|
898
|
30
|
100
|
|
|
|
118
|
is_allowed_computation => $is_allowed_computation, |
|
899
|
|
|
|
|
|
|
is_global => $GLOBAL_DECLARATION{$type}, |
|
900
|
20
|
100
|
|
|
|
606
|
is_state_in_expression => $is_state_in_expression, |
|
901
|
|
|
|
|
|
|
taking_reference => _element_takes_reference( $cast ), |
|
902
|
12
|
|
|
|
|
45
|
); |
|
903
|
12
|
100
|
|
|
|
130
|
|
|
904
|
|
|
|
|
|
|
return; |
|
905
|
|
|
|
|
|
|
} |
|
906
|
|
|
|
|
|
|
|
|
907
|
9
|
|
|
|
|
121
|
if ( delete $self->{$PACKAGE}{need_sort} ) { |
|
908
|
|
|
|
|
|
|
# Because we need multiple passes to find all the declarations, |
|
909
|
9
|
|
|
|
|
156
|
# we have to put them in reverse order when we're done. We need |
|
910
|
9
|
50
|
|
|
|
225
|
# to repeat the check because of the possibility of picking up |
|
911
|
0
|
|
|
|
|
0
|
# declarations made in passing while trying to find uses. |
|
912
|
0
|
0
|
|
|
|
0
|
# Re the 'no critic' annotation: I understand that 'reverse ...' |
|
913
|
|
|
|
|
|
|
# is faster and clearer than 'sort { $b cmp $a } ...', but I |
|
914
|
|
|
|
|
|
|
# think the dereferenes negate this. |
|
915
|
|
|
|
|
|
|
foreach my $decls ( values %{ $self->{$PACKAGE}{declared} } ) { |
|
916
|
9
|
|
|
|
|
43
|
@{ $decls } = map { $_->[0] } |
|
917
|
|
|
|
|
|
|
sort { ## no critic (ProhibitReverseSortBlock) |
|
918
|
|
|
|
|
|
|
$b->[1][LOCATION_LOGICAL_LINE] <=> |
|
919
|
|
|
|
|
|
|
$a->[1][LOCATION_LOGICAL_LINE] || |
|
920
|
|
|
|
|
|
|
$b->[1][LOCATION_CHARACTER] <=> |
|
921
|
|
|
|
|
|
|
$a->[1][LOCATION_CHARACTER] |
|
922
|
|
|
|
|
|
|
} |
|
923
|
|
|
|
|
|
|
map { [ $_, $_->{element}->location() ] } |
|
924
|
9
|
|
|
|
|
59
|
@{ $decls }; |
|
925
|
|
|
|
|
|
|
} |
|
926
|
|
|
|
|
|
|
} |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
foreach my $decl_scope ( @{ $declaration } ) { |
|
929
|
9
|
|
|
|
|
34
|
$self->_derived_element_is_in_lexical_scope_after_statement_containing( |
|
930
|
|
|
|
|
|
|
$symbol, $decl_scope->{declaration} ) |
|
931
|
|
|
|
|
|
|
or next; |
|
932
|
70
|
100
|
|
|
|
273
|
$decl_scope->{used}++; |
|
933
|
|
|
|
|
|
|
if ( $self->{_trace}{$symbol_name} ) { |
|
934
|
|
|
|
|
|
|
my $elem = $decl_scope->{element}; |
|
935
|
|
|
|
|
|
|
printf { *STDERR } |
|
936
|
|
|
|
|
|
|
"%s at line %d col %d refers to 0x%x at line %d col %d\n", |
|
937
|
|
|
|
|
|
|
$symbol_name, |
|
938
|
|
|
|
|
|
|
$symbol->logical_line_number(), |
|
939
|
|
|
|
|
|
|
$symbol->column_number(), |
|
940
|
33
|
|
|
|
|
71
|
refaddr( $elem ), |
|
|
33
|
|
|
|
|
205
|
|
|
941
|
56
|
|
|
|
|
177
|
$elem->logical_line_number(), |
|
|
70
|
|
|
|
|
610
|
|
|
942
|
|
|
|
|
|
|
$elem->column_number(), |
|
943
|
14
|
50
|
|
|
|
257
|
; |
|
944
|
|
|
|
|
|
|
} |
|
945
|
|
|
|
|
|
|
return; |
|
946
|
|
|
|
|
|
|
} |
|
947
|
|
|
|
|
|
|
|
|
948
|
70
|
|
|
|
|
360
|
if ( $self->{_trace}{$symbol_name} ) { |
|
949
|
56
|
|
|
|
|
123
|
printf { *STDERR } |
|
|
56
|
|
|
|
|
125
|
|
|
950
|
|
|
|
|
|
|
"Failed to resolve %s at line %d col %d\n", |
|
951
|
|
|
|
|
|
|
$symbol_name, |
|
952
|
|
|
|
|
|
|
$symbol->logical_line_number(), |
|
953
|
70
|
|
|
|
|
153
|
$symbol->column_number(), |
|
|
70
|
|
|
|
|
244
|
|
|
954
|
|
|
|
|
|
|
; |
|
955
|
|
|
|
|
|
|
} |
|
956
|
85
|
100
|
|
|
|
458
|
|
|
957
|
70
|
|
|
|
|
1174
|
return; |
|
958
|
70
|
50
|
|
|
|
260
|
|
|
959
|
0
|
|
|
|
|
0
|
} |
|
960
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
961
|
|
|
|
|
|
|
my ( $self, $inner_elem, $outer_elem ) = @_; |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
my $effective_inner = $self->_get_lowest_in_same_doc( $inner_elem, |
|
964
|
|
|
|
|
|
|
$outer_elem ) |
|
965
|
|
|
|
|
|
|
or return $FALSE; |
|
966
|
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
return _element_is_in_lexical_scope_after_statement_containing( |
|
968
|
|
|
|
|
|
|
$effective_inner, $outer_elem ); |
|
969
|
|
|
|
|
|
|
|
|
970
|
70
|
|
|
|
|
239
|
} |
|
971
|
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
973
|
0
|
0
|
|
|
|
0
|
|
|
974
|
0
|
|
|
|
|
0
|
my ( $elem ) = @_; |
|
|
0
|
|
|
|
|
0
|
|
|
975
|
|
|
|
|
|
|
return $elem && $elem->isa( 'PPI::Token::Cast' ) && |
|
976
|
|
|
|
|
|
|
$BSLASH eq $elem->content(); |
|
977
|
|
|
|
|
|
|
} |
|
978
|
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
980
|
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
|
982
|
0
|
|
|
|
|
0
|
|
|
983
|
|
|
|
|
|
|
foreach my $class ( @DOUBLE_QUOTISH ) { |
|
984
|
|
|
|
|
|
|
foreach my $double_quotish ( |
|
985
|
|
|
|
|
|
|
@{ $document->find( $class ) || [] } |
|
986
|
|
|
|
|
|
|
) { |
|
987
|
85
|
|
|
85
|
|
237
|
|
|
988
|
|
|
|
|
|
|
my $str = $self->_get_ppix_quotelike( $double_quotish ) |
|
989
|
85
|
100
|
|
|
|
289
|
or next; |
|
990
|
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
foreach my $interp ( @{ |
|
992
|
|
|
|
|
|
|
$str->find( 'PPIx::QuoteLike::Token::Interpolation' ) || [] } ) { |
|
993
|
81
|
|
|
|
|
755
|
|
|
994
|
|
|
|
|
|
|
my $subdoc = $self->_get_derived_ppi_document( |
|
995
|
|
|
|
|
|
|
$interp, $double_quotish ) |
|
996
|
|
|
|
|
|
|
or next; |
|
997
|
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
$self->_get_symbol_uses( $subdoc, $double_quotish ); |
|
999
|
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
} |
|
1001
|
9
|
|
|
9
|
|
24
|
|
|
1002
|
9
|
|
33
|
|
|
124
|
} |
|
1003
|
|
|
|
|
|
|
} |
|
1004
|
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
return; |
|
1006
|
|
|
|
|
|
|
} |
|
1007
|
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
1009
|
99
|
|
|
99
|
|
278
|
|
|
1010
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
|
1011
|
99
|
|
|
|
|
338
|
|
|
1012
|
594
|
|
|
|
|
50009
|
foreach my $class ( @REGEXP_ISH ) { |
|
1013
|
594
|
100
|
|
|
|
1492
|
|
|
1014
|
|
|
|
|
|
|
foreach my $regex ( @{ $document->find( $class ) || [] } ) { |
|
1015
|
|
|
|
|
|
|
|
|
1016
|
30
|
50
|
|
|
|
843
|
my $pre = $self->_get_ppix_regexp( $regex ) |
|
1017
|
|
|
|
|
|
|
or next; |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
30
|
|
|
|
|
93
|
foreach my $code ( @{ |
|
1020
|
30
|
100
|
|
|
|
213
|
$pre->find( 'PPIx::Regexp::Token::Code' ) || [] } ) { |
|
1021
|
|
|
|
|
|
|
|
|
1022
|
27
|
50
|
|
|
|
1688
|
my $subdoc = $self->_get_derived_ppi_document( $code, |
|
1023
|
|
|
|
|
|
|
$regex ); |
|
1024
|
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
$self->_get_symbol_uses( $subdoc, $regex ); |
|
1026
|
27
|
|
|
|
|
130
|
} |
|
1027
|
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
} |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
} |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
return; |
|
1033
|
99
|
|
|
|
|
10190
|
} |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
1036
|
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
# Stolen shamelessly from OALDERS' App::perlimports::Include |
|
1038
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
|
1039
|
99
|
|
|
99
|
|
278
|
|
|
1040
|
|
|
|
|
|
|
# FIXME as of PPI 1.272, signatures are parsed as prototypes. |
|
1041
|
99
|
|
|
|
|
647
|
foreach my $class ( qw{ PPI::Token::Prototype } ) { |
|
1042
|
|
|
|
|
|
|
foreach my $elem ( @{ $document->find( $class ) || [] } ) { |
|
1043
|
297
|
100
|
|
|
|
20757
|
my $sig = $elem->content(); |
|
|
297
|
|
|
|
|
849
|
|
|
1044
|
|
|
|
|
|
|
|
|
1045
|
9
|
50
|
|
|
|
880
|
# Skip over things that might actually be prototypes. Some |
|
1046
|
|
|
|
|
|
|
# of them may actually be signatures, but if so they specify |
|
1047
|
|
|
|
|
|
|
# only ignored variables, or maybe magic variables like $_ |
|
1048
|
9
|
|
|
|
|
34
|
# or @_. |
|
1049
|
9
|
50
|
|
|
|
86
|
$sig =~ m/ [[:alpha:]\d] /smx |
|
1050
|
|
|
|
|
|
|
or next; |
|
1051
|
9
|
|
|
|
|
3264
|
|
|
1052
|
|
|
|
|
|
|
# Strip leading and trailing parens. OALDERS' comments say |
|
1053
|
|
|
|
|
|
|
# that sometimes the trailing one is missing. |
|
1054
|
9
|
|
|
|
|
39
|
$sig =~ s/ \A \s* [(] \s* //smx; |
|
1055
|
|
|
|
|
|
|
$sig =~ s/ \s* [)] \s* \z //smx; |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
# Rewrite the signature as statements. |
|
1058
|
|
|
|
|
|
|
my @args; |
|
1059
|
|
|
|
|
|
|
foreach ( split / , /smx, $sig ) { |
|
1060
|
|
|
|
|
|
|
s/ \s+ \z //smx; |
|
1061
|
99
|
|
|
|
|
10381
|
s/ \A \s+ //smx; |
|
1062
|
|
|
|
|
|
|
# Skip unused arguments, since we're not interested in |
|
1063
|
|
|
|
|
|
|
# their position in the argument list. |
|
1064
|
|
|
|
|
|
|
m/ \A [\$\@%] (?: \s* = | \z ) /smx |
|
1065
|
|
|
|
|
|
|
and next; |
|
1066
|
|
|
|
|
|
|
# Ignore empty defaults. |
|
1067
|
|
|
|
|
|
|
s/ = \z //smx; |
|
1068
|
99
|
|
|
99
|
|
284
|
# FIXME there ought to be a 'my' in front, but because |
|
1069
|
|
|
|
|
|
|
# this policy has no way to find the uses of this |
|
1070
|
|
|
|
|
|
|
# variable it results in false positives. MAYBE I could |
|
1071
|
99
|
|
|
|
|
268
|
# fix this by calling _get_symbol_declarations() on |
|
1072
|
99
|
100
|
|
|
|
194
|
# $subdoc (in _element_to_ppi() so it only gets called |
|
|
99
|
|
|
|
|
302
|
|
|
1073
|
3
|
|
|
|
|
40
|
# once), but I don't think I want that in the same |
|
1074
|
|
|
|
|
|
|
# commit, or even the same release, as the bug fix. |
|
1075
|
|
|
|
|
|
|
push @args, "$_;"; |
|
1076
|
|
|
|
|
|
|
} |
|
1077
|
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
my $subdoc = $self->_element_to_ppi( $elem, "@args" ) |
|
1079
|
3
|
50
|
|
|
|
357
|
or next; |
|
1080
|
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
$self->_get_symbol_uses( $subdoc, $elem ); |
|
1082
|
|
|
|
|
|
|
} |
|
1083
|
|
|
|
|
|
|
} |
|
1084
|
3
|
|
|
|
|
25
|
|
|
1085
|
3
|
|
|
|
|
20
|
return; |
|
1086
|
|
|
|
|
|
|
} |
|
1087
|
|
|
|
|
|
|
|
|
1088
|
3
|
|
|
|
|
9
|
#----------------------------------------------------------------------------- |
|
1089
|
3
|
|
|
|
|
20
|
|
|
1090
|
5
|
|
|
|
|
20
|
my ( $self ) = @_; |
|
1091
|
5
|
|
|
|
|
15
|
|
|
1092
|
|
|
|
|
|
|
my @in_violation; |
|
1093
|
|
|
|
|
|
|
|
|
1094
|
5
|
100
|
|
|
|
25
|
foreach my $name ( values %{ $self->{$PACKAGE}{declared} } ) { |
|
1095
|
|
|
|
|
|
|
foreach my $declaration ( @{ $name } ) { |
|
1096
|
|
|
|
|
|
|
$declaration->{is_global} |
|
1097
|
3
|
|
|
|
|
11
|
and next; |
|
1098
|
|
|
|
|
|
|
$declaration->{used} |
|
1099
|
|
|
|
|
|
|
and next; |
|
1100
|
|
|
|
|
|
|
$declaration->{is_allowed_computation} |
|
1101
|
|
|
|
|
|
|
and next; |
|
1102
|
|
|
|
|
|
|
$declaration->{is_state_in_expression} |
|
1103
|
|
|
|
|
|
|
and $self->{_allow_state_in_expression} |
|
1104
|
|
|
|
|
|
|
and next; |
|
1105
|
3
|
|
|
|
|
22
|
$declaration->{taking_reference} |
|
1106
|
|
|
|
|
|
|
and not $self->{_prohibit_reference_only_variables} |
|
1107
|
|
|
|
|
|
|
and next; |
|
1108
|
3
|
50
|
|
|
|
27
|
$declaration->{returned_lexical} |
|
1109
|
|
|
|
|
|
|
and not $self->{_prohibit_returned_lexicals} |
|
1110
|
|
|
|
|
|
|
and next; |
|
1111
|
3
|
|
|
|
|
17
|
$declaration->{is_unpacking} |
|
1112
|
|
|
|
|
|
|
and $self->{_allow_unused_subroutine_arguments} |
|
1113
|
|
|
|
|
|
|
and next; |
|
1114
|
|
|
|
|
|
|
push @in_violation, $declaration->{element}; |
|
1115
|
99
|
|
|
|
|
9445
|
} |
|
1116
|
|
|
|
|
|
|
} |
|
1117
|
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
return ( map { $self->violation( |
|
1119
|
|
|
|
|
|
|
sprintf( '%s is declared but not used', $_->symbol() ), |
|
1120
|
|
|
|
|
|
|
$EXPL, |
|
1121
|
60
|
|
|
60
|
|
247
|
$_ |
|
1122
|
|
|
|
|
|
|
) } sort { $a->logical_line_number() <=> $b->logical_line_number() || |
|
1123
|
60
|
|
|
|
|
115
|
$a->column_number() <=> $b->column_number() } |
|
1124
|
|
|
|
|
|
|
@in_violation ); |
|
1125
|
60
|
|
|
|
|
109
|
} |
|
|
60
|
|
|
|
|
438
|
|
|
1126
|
103
|
|
|
|
|
191
|
|
|
|
103
|
|
|
|
|
273
|
|
|
1127
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
1128
|
126
|
100
|
|
|
|
486
|
|
|
1129
|
|
|
|
|
|
|
# THIS CODE HAS ABSOLUTELY NO BUSINESS BEING HERE. It should probably be |
|
1130
|
125
|
100
|
|
|
|
354
|
# its own module; PPIx::Scope or something like that. The problem is |
|
1131
|
|
|
|
|
|
|
# that I no longer "own" it, and am having trouble getting modifications |
|
1132
|
63
|
100
|
|
|
|
158
|
# through. So I have stuck it here for the moment, but I hope it will |
|
1133
|
|
|
|
|
|
|
# not stay here. Other than here, it appears in Perl::Critic::Document |
|
1134
|
|
|
|
|
|
|
# (the copy I am trying to get modified) and Perl::ToPerl6::Document (a |
|
1135
|
62
|
100
|
100
|
|
|
178
|
# cut-and-paste of an early version.) |
|
1136
|
|
|
|
|
|
|
# |
|
1137
|
|
|
|
|
|
|
# THIS CODE IS PRIVATE TO THIS MODULE. The author reserves the right to |
|
1138
|
58
|
100
|
100
|
|
|
175
|
# change it or remove it without any notice whatsoever. YOU HAVE BEEN |
|
1139
|
|
|
|
|
|
|
# WARNED. |
|
1140
|
|
|
|
|
|
|
# |
|
1141
|
54
|
100
|
100
|
|
|
138
|
# This got hung on the Perl::Critic::Document, rather than living in |
|
1142
|
|
|
|
|
|
|
# Perl::Critic::Utils::PPI, because of the possibility that caching of scope |
|
1143
|
|
|
|
|
|
|
# objects would turn out to be desirable. |
|
1144
|
50
|
100
|
100
|
|
|
129
|
|
|
1145
|
44
|
|
|
|
|
107
|
# sub element_is_in_lexical_scope_after_statement_containing {...} |
|
1146
|
|
|
|
|
|
|
my ( $inner_elem, $outer_elem ) = @_; |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
$inner_elem->top() == $outer_elem->top() |
|
1149
|
44
|
|
|
|
|
4390
|
or Perl::Critic::Exception::Fatal::PolicyDefinition->throw( |
|
1150
|
|
|
|
|
|
|
message => 'Elements must be in same document' ); |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
# If the outer element defines a scope, we're true if and only if |
|
1153
|
60
|
50
|
|
|
|
400
|
# the outer element contains the inner element, and the inner |
|
|
28
|
|
|
|
|
463
|
|
|
1154
|
|
|
|
|
|
|
# element is not somewhere that is hidden from the scope. |
|
1155
|
|
|
|
|
|
|
if ( $outer_elem->scope() ) { |
|
1156
|
|
|
|
|
|
|
return _inner_element_is_in_outer_scope_really( |
|
1157
|
|
|
|
|
|
|
$inner_elem, $outer_elem ); |
|
1158
|
|
|
|
|
|
|
} |
|
1159
|
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
# In the more general case: |
|
1161
|
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
# The last element of the statement containing the outer element |
|
1163
|
|
|
|
|
|
|
# must be before the inner element. If not, we know we're false, |
|
1164
|
|
|
|
|
|
|
# without walking the parse tree. |
|
1165
|
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
my $stmt = $outer_elem->statement() |
|
1167
|
|
|
|
|
|
|
or return; |
|
1168
|
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
my $last_elem = $stmt; |
|
1170
|
|
|
|
|
|
|
while ( $last_elem->isa( 'PPI::Node' ) ) { |
|
1171
|
|
|
|
|
|
|
$last_elem = $last_elem->last_element() |
|
1172
|
|
|
|
|
|
|
or return; |
|
1173
|
|
|
|
|
|
|
} |
|
1174
|
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
my $stmt_loc = $last_elem->location() |
|
1176
|
|
|
|
|
|
|
or return; |
|
1177
|
|
|
|
|
|
|
|
|
1178
|
81
|
|
|
81
|
|
205
|
my $inner_loc = $inner_elem->location() |
|
1179
|
|
|
|
|
|
|
or return; |
|
1180
|
81
|
50
|
|
|
|
198
|
|
|
1181
|
|
|
|
|
|
|
$stmt_loc->[LOCATION_LINE] > $inner_loc->[LOCATION_LINE] |
|
1182
|
|
|
|
|
|
|
and return; |
|
1183
|
|
|
|
|
|
|
$stmt_loc->[LOCATION_LINE] == $inner_loc->[LOCATION_LINE] |
|
1184
|
|
|
|
|
|
|
and $stmt_loc->[LOCATION_CHARACTER] >= $inner_loc->[LOCATION_CHARACTER] |
|
1185
|
|
|
|
|
|
|
and return; |
|
1186
|
|
|
|
|
|
|
|
|
1187
|
81
|
100
|
|
|
|
1628
|
# Since we know the inner element is after the outer element, find |
|
1188
|
6
|
|
|
|
|
18
|
# the element that defines the scope of the statement that contains |
|
1189
|
|
|
|
|
|
|
# the outer element. |
|
1190
|
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
my $parent = $stmt; |
|
1192
|
|
|
|
|
|
|
while ( ! $parent->scope() ) { |
|
1193
|
|
|
|
|
|
|
# Things appearing in the right-hand side of a |
|
1194
|
|
|
|
|
|
|
# PPI::Statement::Variable are not in-scope to its left-hand |
|
1195
|
|
|
|
|
|
|
# side. RESTRICTION -- this code does not handle truly |
|
1196
|
|
|
|
|
|
|
# pathological stuff like |
|
1197
|
|
|
|
|
|
|
# my ( $c, $d ) = qw{ e f }; |
|
1198
|
75
|
50
|
|
|
|
381
|
# my ( $a, $b ) = my ( $c, $d ) = ( $c, $d ); |
|
1199
|
|
|
|
|
|
|
_inner_is_defined_by_outer( $inner_elem, $parent ) |
|
1200
|
|
|
|
|
|
|
and _location_is_in_right_hand_side_of_assignment( |
|
1201
|
75
|
|
|
|
|
920
|
$parent, $inner_elem ) |
|
1202
|
75
|
|
|
|
|
286
|
and return; |
|
1203
|
77
|
50
|
|
|
|
277
|
$parent = $parent->parent() |
|
1204
|
|
|
|
|
|
|
or return; |
|
1205
|
|
|
|
|
|
|
} |
|
1206
|
|
|
|
|
|
|
|
|
1207
|
75
|
50
|
|
|
|
638
|
# We're true if and only if the scope of the outer element contains |
|
1208
|
|
|
|
|
|
|
# the inner element. |
|
1209
|
|
|
|
|
|
|
|
|
1210
|
75
|
50
|
|
|
|
1087
|
return $inner_elem->descendant_of( $parent ); |
|
1211
|
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
} |
|
1213
|
75
|
50
|
|
|
|
966
|
|
|
1214
|
|
|
|
|
|
|
# Helper for element_is_in_lexical_scope_after_statement_containing(). |
|
1215
|
75
|
100
|
100
|
|
|
305
|
# Return true if and only if $outer_elem is a statement that defines |
|
1216
|
|
|
|
|
|
|
# variables and $inner_elem is actually a variable defined in that |
|
1217
|
|
|
|
|
|
|
# statement. |
|
1218
|
|
|
|
|
|
|
my ( $inner_elem, $outer_elem ) = @_; |
|
1219
|
|
|
|
|
|
|
$outer_elem->isa( 'PPI::Statement::Variable' ) |
|
1220
|
|
|
|
|
|
|
and $inner_elem->isa( 'PPI::Token::Symbol' ) |
|
1221
|
|
|
|
|
|
|
or return; |
|
1222
|
|
|
|
|
|
|
my %defines = hashify( $outer_elem->variables() ); |
|
1223
|
70
|
|
|
|
|
144
|
return $defines{$inner_elem->symbol()}; |
|
1224
|
70
|
|
|
|
|
231
|
} |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
# Helper for element_is_in_lexical_scope_after_statement_containing(). |
|
1227
|
|
|
|
|
|
|
# Given that the outer element defines a scope, there are still things |
|
1228
|
|
|
|
|
|
|
# that are lexically inside it but outside the scope. We return true if |
|
1229
|
|
|
|
|
|
|
# and only if the inner element is inside the outer element, but not |
|
1230
|
|
|
|
|
|
|
# inside one of the excluded elements. The cases handled so far: |
|
1231
|
75
|
50
|
66
|
|
|
299
|
# for ----- the list is not part of the scope |
|
1232
|
|
|
|
|
|
|
# foreach - the list is not part of the scope |
|
1233
|
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
my ( $inner_elem, $outer_elem ) = @_; |
|
1235
|
75
|
50
|
|
|
|
696
|
$outer_elem->scope() |
|
1236
|
|
|
|
|
|
|
or return; |
|
1237
|
|
|
|
|
|
|
$inner_elem->descendant_of( $outer_elem ) |
|
1238
|
|
|
|
|
|
|
or return; |
|
1239
|
|
|
|
|
|
|
if ( $outer_elem->isa( 'PPI::Statement::Compound' ) ) { |
|
1240
|
|
|
|
|
|
|
my $first = $outer_elem->schild( 0 ) |
|
1241
|
|
|
|
|
|
|
or return; |
|
1242
|
70
|
|
|
|
|
733
|
if ( { for => 1, foreach => 1 }->{ $first->content() } ) { |
|
1243
|
|
|
|
|
|
|
my $next = $first; |
|
1244
|
|
|
|
|
|
|
while ( $next = $next->snext_sibling() ) { |
|
1245
|
|
|
|
|
|
|
$next->isa( 'PPI::Structure::List' ) |
|
1246
|
|
|
|
|
|
|
or next; |
|
1247
|
|
|
|
|
|
|
return ! $inner_elem->descendant_of( $next ); |
|
1248
|
|
|
|
|
|
|
} |
|
1249
|
|
|
|
|
|
|
} |
|
1250
|
|
|
|
|
|
|
} |
|
1251
|
75
|
|
|
75
|
|
189
|
return $TRUE; |
|
1252
|
75
|
100
|
100
|
|
|
655
|
} |
|
1253
|
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
# Helper for element_is_in_lexical_scope_after_statement_containing(). |
|
1255
|
36
|
|
|
|
|
138
|
# Given and element that represents an assignment or assignment-ish |
|
1256
|
36
|
|
|
|
|
2412
|
# statement, and a location, return true if the location is to the right |
|
1257
|
|
|
|
|
|
|
# of the equals sign, and false otherwise (including the case where |
|
1258
|
|
|
|
|
|
|
# there is no equals sign). Only the leftmost equals is considered. This |
|
1259
|
|
|
|
|
|
|
# is a restriction. |
|
1260
|
|
|
|
|
|
|
my ( $elem, $inner_elem ) = @_; |
|
1261
|
|
|
|
|
|
|
my $inner_loc = $inner_elem->location(); |
|
1262
|
|
|
|
|
|
|
my $kid = $elem->schild( 0 ); |
|
1263
|
|
|
|
|
|
|
while ( $kid ) { |
|
1264
|
|
|
|
|
|
|
$kid->isa( 'PPI::Token::Operator' ) |
|
1265
|
|
|
|
|
|
|
and q{=} eq $kid->content() |
|
1266
|
|
|
|
|
|
|
or next; |
|
1267
|
|
|
|
|
|
|
my $l = $kid->location(); |
|
1268
|
6
|
|
|
6
|
|
18
|
$l->[LOCATION_LINE] > $inner_loc->[LOCATION_LINE] |
|
1269
|
6
|
50
|
|
|
|
18
|
and return; |
|
1270
|
|
|
|
|
|
|
$l->[LOCATION_LINE] == $inner_loc->[LOCATION_LINE] |
|
1271
|
6
|
50
|
|
|
|
20
|
and $l->[LOCATION_CHARACTER] >= $inner_loc->[LOCATION_CHARACTER] |
|
1272
|
|
|
|
|
|
|
and return; |
|
1273
|
6
|
50
|
|
|
|
106
|
return $inner_elem->descendant_of( $elem ); |
|
1274
|
6
|
50
|
|
|
|
17
|
} continue { |
|
1275
|
|
|
|
|
|
|
$kid = $kid->snext_sibling(); |
|
1276
|
6
|
50
|
|
|
|
85
|
} |
|
1277
|
6
|
|
|
|
|
28
|
return; |
|
1278
|
6
|
|
|
|
|
58
|
} |
|
1279
|
18
|
100
|
|
|
|
364
|
|
|
1280
|
|
|
|
|
|
|
# END OF CODE THAT ABSOLUTELY SHOULD NOT BE HERE |
|
1281
|
6
|
|
|
|
|
45
|
|
|
1282
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
1283
|
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
# Cribbed shamelessly from PPIx::Regexp::Token::Code->ppi(). |
|
1285
|
0
|
|
|
|
|
0
|
# FIXME duplicate code should be consolidated somewhere, but I don't |
|
1286
|
|
|
|
|
|
|
# know where. Maybe in the above scope code, since that's what I'm |
|
1287
|
|
|
|
|
|
|
# trying to solve. |
|
1288
|
|
|
|
|
|
|
my ( $self, $elem, $content ) = @_; |
|
1289
|
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
exists $self->{$PACKAGE}{sub_document}{ refaddr( $elem ) } |
|
1291
|
|
|
|
|
|
|
and return $self->{$PACKAGE}{sub_document}{ refaddr( $elem ) }; |
|
1292
|
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
defined $content |
|
1294
|
|
|
|
|
|
|
or $content = $self->content(); |
|
1295
|
36
|
|
|
36
|
|
1613
|
|
|
1296
|
36
|
|
|
|
|
91
|
my $doc_content; |
|
1297
|
36
|
|
|
|
|
390
|
|
|
1298
|
36
|
|
|
|
|
475
|
my $location = $elem->location(); |
|
1299
|
111
|
100
|
100
|
|
|
1631
|
if ( $location ) { |
|
1300
|
|
|
|
|
|
|
my $fn; |
|
1301
|
|
|
|
|
|
|
if( defined( $fn = $location->[LOCATION_LOGICAL_FILE] ) ) { |
|
1302
|
27
|
|
|
|
|
185
|
$fn =~ s/ (?= [\\"] ) /\\/smxg; |
|
1303
|
27
|
50
|
|
|
|
305
|
$doc_content = qq{#line $location->[LOCATION_LOGICAL_LINE] "$fn"\n}; |
|
1304
|
|
|
|
|
|
|
} else { |
|
1305
|
27
|
50
|
66
|
|
|
168
|
$doc_content = qq{#line $location->[LOCATION_LOGICAL_LINE]\n}; |
|
1306
|
|
|
|
|
|
|
} |
|
1307
|
|
|
|
|
|
|
$doc_content .= q< > x ( $location->[LOCATION_COLUMN] - 1 ); |
|
1308
|
27
|
|
|
|
|
99
|
} |
|
1309
|
|
|
|
|
|
|
|
|
1310
|
84
|
|
|
|
|
227
|
$doc_content .= $content; |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
9
|
|
|
|
|
200
|
my $doc = PPI::Document->new( \$doc_content ); |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
if ( $location ) { |
|
1315
|
|
|
|
|
|
|
# Generate locations now. |
|
1316
|
|
|
|
|
|
|
$doc->location(); |
|
1317
|
|
|
|
|
|
|
# Remove the stuff we originally injected. NOTE that we can |
|
1318
|
|
|
|
|
|
|
# only get away with doing this if the removal does not |
|
1319
|
|
|
|
|
|
|
# invalidate the locations of the other tokens that we just |
|
1320
|
|
|
|
|
|
|
# generated. |
|
1321
|
|
|
|
|
|
|
my $annotation; |
|
1322
|
|
|
|
|
|
|
# Remove the '#line' directive if we find it |
|
1323
|
|
|
|
|
|
|
$annotation = $doc->child( 0 ) |
|
1324
|
3
|
|
|
3
|
|
12
|
and $annotation->isa( 'PPI::Token::Comment' ) |
|
1325
|
|
|
|
|
|
|
and $annotation->content() =~ m/ \A \#line\b /smx |
|
1326
|
|
|
|
|
|
|
and $annotation->remove(); |
|
1327
|
3
|
50
|
|
|
|
29
|
# Remove the white space if we find it, and if it in fact |
|
1328
|
|
|
|
|
|
|
# represents only the white space we injected to get the |
|
1329
|
3
|
50
|
|
|
|
13
|
# column numbers right. |
|
1330
|
|
|
|
|
|
|
my $wid = $location->[LOCATION_COLUMN] - 1; |
|
1331
|
|
|
|
|
|
|
$wid |
|
1332
|
3
|
|
|
|
|
9
|
and $annotation = $doc->child( 0 ) |
|
1333
|
|
|
|
|
|
|
and $annotation->isa( 'PPI::Token::Whitespace' ) |
|
1334
|
3
|
|
|
|
|
30
|
and $wid == length $annotation->content() |
|
1335
|
3
|
50
|
|
|
|
56
|
and $annotation->remove(); |
|
1336
|
3
|
|
|
|
|
7
|
} |
|
1337
|
3
|
50
|
|
|
|
18
|
|
|
1338
|
0
|
|
|
|
|
0
|
$self->{$PACKAGE}{parent_element}{ refaddr( $doc ) } = $elem; |
|
1339
|
0
|
|
|
|
|
0
|
return ( $self->{$PACKAGE}{sub_document}{ refaddr( $elem ) } = $doc ); |
|
1340
|
|
|
|
|
|
|
} |
|
1341
|
3
|
|
|
|
|
15
|
|
|
1342
|
|
|
|
|
|
|
1; |
|
1343
|
3
|
|
|
|
|
84
|
|
|
1344
|
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
|
1346
|
3
|
|
|
|
|
10
|
|
|
1347
|
|
|
|
|
|
|
=pod |
|
1348
|
3
|
|
|
|
|
28
|
|
|
1349
|
|
|
|
|
|
|
=for stopwords pre |
|
1350
|
3
|
50
|
|
|
|
4869
|
|
|
1351
|
|
|
|
|
|
|
=head1 NAME |
|
1352
|
3
|
|
|
|
|
17
|
|
|
1353
|
|
|
|
|
|
|
Perl::Critic::Policy::Variables::ProhibitUnusedVarsStricter - Don't ask for storage you don't need. |
|
1354
|
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=head1 AFFILIATION |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
3
|
|
|
|
|
1065
|
This Policy is stand-alone, and is not part of the core |
|
1358
|
|
|
|
|
|
|
L<Perl::Critic|Perl::Critic>. |
|
1359
|
3
|
50
|
33
|
|
|
18
|
|
|
|
|
|
33
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
=head1 NOTE |
|
1361
|
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
As of version 0.099_001, the logic that recognizes variables |
|
1363
|
|
|
|
|
|
|
interpolated into double-quotish strings has been refactored into module |
|
1364
|
|
|
|
|
|
|
L<PPIx::QuoteLike|PPIx::QuoteLike>. |
|
1365
|
|
|
|
|
|
|
|
|
1366
|
3
|
|
|
|
|
252
|
=head1 DESCRIPTION |
|
1367
|
3
|
50
|
33
|
|
|
15
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
Unused variables clutter code and require the reader to do mental |
|
1369
|
|
|
|
|
|
|
bookkeeping to figure out if the variable is actually used or not. |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Right now, this only looks for lexical variables which are unused other |
|
1372
|
|
|
|
|
|
|
than in the statement that declares them. |
|
1373
|
|
|
|
|
|
|
|
|
1374
|
3
|
|
|
|
|
158
|
my $x; # not ok, assuming no other appearances. |
|
1375
|
3
|
|
|
|
|
65
|
my @y = (); # not ok, assuming no other appearances. |
|
1376
|
|
|
|
|
|
|
our $z; # ok, global. |
|
1377
|
|
|
|
|
|
|
local $w; # ok, global. |
|
1378
|
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
This policy is a variant on the core policy |
|
1380
|
|
|
|
|
|
|
L<Perl::Critic::Policy::Variables::ProhibitUnusedVariables|Perl::Critic::Policy::Variables::ProhibitUnusedVariables> |
|
1381
|
|
|
|
|
|
|
which attempts to be more strict in its checking of whether a variable |
|
1382
|
|
|
|
|
|
|
is used. The specific differences are: |
|
1383
|
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
* An attempt is made to take into account the scope of the declaration. |
|
1385
|
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
* An attempt is made to find variables which are interpolated into |
|
1387
|
|
|
|
|
|
|
double-quotish strings (including regexes) and here documents. |
|
1388
|
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
* An attempt is made to find variables which are used in regular |
|
1390
|
|
|
|
|
|
|
expression C<(?{...})> and C<(??{...})> constructions, and in the |
|
1391
|
|
|
|
|
|
|
replacement portion of C<s/.../.../e>. |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
* An attempt is made to find variables which are used in subroutine |
|
1394
|
|
|
|
|
|
|
signatures. |
|
1395
|
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
This policy intentionally does not report variables as unused if the |
|
1397
|
|
|
|
|
|
|
code takes a reference to the variable, even if it is otherwise unused. |
|
1398
|
|
|
|
|
|
|
For example things like |
|
1399
|
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
\( my $foo = 'bar' ) |
|
1401
|
|
|
|
|
|
|
\do{ my $foo => 'bar' } |
|
1402
|
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
will not be reported as a violation even if C<$foo> is otherwise unused. |
|
1404
|
|
|
|
|
|
|
The reason is that this is an idiom for making a reference to a mutable |
|
1405
|
|
|
|
|
|
|
string when all you have is an immutable string. This policy does not |
|
1406
|
|
|
|
|
|
|
check to see if anything is done with the reference. |
|
1407
|
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
This policy also does not detect unused variables declared inside |
|
1409
|
|
|
|
|
|
|
various odd corners such as |
|
1410
|
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
s///e |
|
1412
|
|
|
|
|
|
|
qr{(?{...})} |
|
1413
|
|
|
|
|
|
|
qr{(??{...})} |
|
1414
|
|
|
|
|
|
|
"@{[ ... ]}" |
|
1415
|
|
|
|
|
|
|
( $foo, my $bar ) = ( 1, 2 ) |
|
1416
|
|
|
|
|
|
|
sub ( $foo = $bar ) { ... } # Signature, not prototype |
|
1417
|
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
Most of these are because the PPI parse of the original document does |
|
1419
|
|
|
|
|
|
|
not include the declarations. The list assignment is missed because PPI |
|
1420
|
|
|
|
|
|
|
does not parse it as containing a |
|
1421
|
|
|
|
|
|
|
L<PPI::Statement::Variable|PPI::Statement::Variable>. However, variables |
|
1422
|
|
|
|
|
|
|
B<used> inside such constructions B<will> be detected. |
|
1423
|
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
=head1 CONFIGURATION |
|
1425
|
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
This policy supports the following configuration items: |
|
1427
|
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=head2 allow_unused_subroutine_arguments |
|
1429
|
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
By default, this policy prohibits unused subroutine arguments -- that |
|
1431
|
|
|
|
|
|
|
is, unused variables on the right-hand side of such simple assignments |
|
1432
|
|
|
|
|
|
|
as |
|
1433
|
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
my ( $foo ) = @_; |
|
1435
|
|
|
|
|
|
|
my $bar = shift; |
|
1436
|
|
|
|
|
|
|
my $baz = shift @_; |
|
1437
|
|
|
|
|
|
|
my $burfle = $_[0]; |
|
1438
|
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
If you wish to allow unused variables in this case, you can add a block |
|
1440
|
|
|
|
|
|
|
like this to your F<.perlcriticrc> file: |
|
1441
|
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
|
1443
|
|
|
|
|
|
|
allow_unused_subroutine_arguments = 1 |
|
1444
|
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
=head2 prohibit_reference_only_variables |
|
1446
|
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
By default, this policy allows otherwise-unused variables if the code |
|
1448
|
|
|
|
|
|
|
takes a reference to the variable when it is created. If you wish to |
|
1449
|
|
|
|
|
|
|
declare a violation in this case, you can add a block like this to your |
|
1450
|
|
|
|
|
|
|
F<.perlcriticrc> file: |
|
1451
|
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
|
1453
|
|
|
|
|
|
|
prohibit_reference_only_variables = 1 |
|
1454
|
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=head2 prohibit_returned_lexicals |
|
1456
|
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
By default, this policy allows otherwise-unused lexical variables |
|
1458
|
|
|
|
|
|
|
(either C<'my'> or C<'state'>) if they are being returned from a |
|
1459
|
|
|
|
|
|
|
subroutine, under the presumption that they are going to be used as |
|
1460
|
|
|
|
|
|
|
lvalues by the caller. If you wish to declare a violation in this case, |
|
1461
|
|
|
|
|
|
|
you can add a block like this to your F<.perlcriticrc> file: |
|
1462
|
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
|
1464
|
|
|
|
|
|
|
prohibit_returned_lexicals = 1 |
|
1465
|
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
B<Note> that only explicit C<'return'> statements are covered by this |
|
1467
|
|
|
|
|
|
|
setting. No attempt is made to detect and allow implicit returns. |
|
1468
|
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
=head2 allow_if_computed_by |
|
1470
|
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
You may wish to allow variables to be unused when computed in certain |
|
1472
|
|
|
|
|
|
|
ways. For example, you might want to allow place-holder variables in a |
|
1473
|
|
|
|
|
|
|
list computed by C<stat()> or C<unpack()>. Or you may be doing |
|
1474
|
|
|
|
|
|
|
end-of-scope detection with something like |
|
1475
|
|
|
|
|
|
|
C<< my $foo = Scope::Guard->new( \&end_of_scope ) >>. To ignore all |
|
1476
|
|
|
|
|
|
|
these, you can add a block like this to your F<.perlcriticrc> file: |
|
1477
|
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
|
1479
|
|
|
|
|
|
|
allow_if_computed_by = stat unpack Scope::Guard |
|
1480
|
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
This property takes as its value a whitespace-delimited list of class or |
|
1482
|
|
|
|
|
|
|
subroutine names. Nothing complex is done to implement this -- the |
|
1483
|
|
|
|
|
|
|
policy simply looks at the first word after the equals sign, if any. |
|
1484
|
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
=head2 allow_state_in_expression |
|
1486
|
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
By default, this policy handles C<state> variables as any other lexical, |
|
1488
|
|
|
|
|
|
|
and a violation is declared if they appear only in the statement that |
|
1489
|
|
|
|
|
|
|
declares them. |
|
1490
|
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
One might, however, do something like |
|
1492
|
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
state $foo = compute_foo() or do_something_else(); |
|
1494
|
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
In this case, C<compute_foo()> is called only once, but if it returns a |
|
1496
|
|
|
|
|
|
|
false value C<do_something_else()> will be executed every time this |
|
1497
|
|
|
|
|
|
|
statement is encountered. |
|
1498
|
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
If you wish to allow such code, you can add a block like this to your |
|
1500
|
|
|
|
|
|
|
F<.perlcriticrc> file: |
|
1501
|
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
|
1503
|
|
|
|
|
|
|
allow_state_in_expression = 1 |
|
1504
|
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
This allows an otherwise-unused state variable if its value appears to |
|
1506
|
|
|
|
|
|
|
be used in an expression -- that is, if its declaration is followed by a |
|
1507
|
|
|
|
|
|
|
low-precedence boolean, or one of its ancestors is preceded or followed |
|
1508
|
|
|
|
|
|
|
by any operator. The latter means that something like |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
my $bar = ( state $foo = compute_foo() ) + 42; |
|
1511
|
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
will be accepted. |
|
1513
|
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
This will also cause post-increment and post-decrement to be accepted, |
|
1515
|
|
|
|
|
|
|
allowing code like |
|
1516
|
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
do_something() unless state $foo++; |
|
1518
|
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
Pre-increment and pre-decrement are ignored, since as of Perl 5.34.0 |
|
1520
|
|
|
|
|
|
|
they are syntax errors. |
|
1521
|
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=head2 check_catch |
|
1523
|
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
Under ordinary circumstances the C<$err> variable in |
|
1525
|
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
try { |
|
1527
|
|
|
|
|
|
|
... |
|
1528
|
|
|
|
|
|
|
} catch ( $err ) { |
|
1529
|
|
|
|
|
|
|
... |
|
1530
|
|
|
|
|
|
|
} |
|
1531
|
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
will be invisible to this policy because, although it is in fact the |
|
1533
|
|
|
|
|
|
|
declaration of a lexical variable, the absence of a C<my> means it does |
|
1534
|
|
|
|
|
|
|
not look like one to L<PPI|PPI>. If you want to test these, you can add |
|
1535
|
|
|
|
|
|
|
a block like this to your F<.perlcriticrc> file: |
|
1536
|
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
|
1538
|
|
|
|
|
|
|
check_catch = 1 |
|
1539
|
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
This option is not on by default because there appears to be no way to |
|
1541
|
|
|
|
|
|
|
define a C<catch()> block without a variable, whether or not you intend |
|
1542
|
|
|
|
|
|
|
to use it. |
|
1543
|
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
B<Caveat:> if L<PPI|PPI> ever starts recognizing C<catch( $foo )> as |
|
1545
|
|
|
|
|
|
|
containing a L<PPI::Statement::Variable|PPI::Statement::Variable>, this |
|
1546
|
|
|
|
|
|
|
configuration variable will become moot, as the extra logic will no |
|
1547
|
|
|
|
|
|
|
longer be needed. As soon as I recognize this has happened (and there |
|
1548
|
|
|
|
|
|
|
B<is> an author test for it) I will document this configuration item as |
|
1549
|
|
|
|
|
|
|
a no-op, deprecate it, and probably eventually retract it. |
|
1550
|
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
=head1 AVOIDING UNUSED VARIABLES |
|
1552
|
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
There are situations in Perl where eliminating unused variables is |
|
1554
|
|
|
|
|
|
|
less straightforward than simply deleting them: |
|
1555
|
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
=head2 List Assignments |
|
1557
|
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
This situation typically (I believe) comes up when your code gets handed |
|
1559
|
|
|
|
|
|
|
a list, and is not interested in all values in the list. You could, of |
|
1560
|
|
|
|
|
|
|
course, assign the whole thing to an array and then cherry-pick the |
|
1561
|
|
|
|
|
|
|
array, but there are less-obvious solutions that avoid the extra |
|
1562
|
|
|
|
|
|
|
assignment. |
|
1563
|
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
For the purpose of this discussion, I will assume code which calls the |
|
1565
|
|
|
|
|
|
|
C<localtime()> built-in, but is only interested in day, month, and year. |
|
1566
|
|
|
|
|
|
|
The cut-and-paste implementation (direct from C<perldoc -f localtime>, |
|
1567
|
|
|
|
|
|
|
or L<https://perldoc.pl/functions/localtime> if you prefer) is: |
|
1568
|
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
# 0 1 2 3 4 5 6 7 8 |
|
1570
|
|
|
|
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
|
1571
|
|
|
|
|
|
|
localtime(); |
|
1572
|
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
Now, you can trivially eliminate the variables after C<$year>, but that |
|
1574
|
|
|
|
|
|
|
still leaves |
|
1575
|
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
# 0 1 2 3 4 5 |
|
1577
|
|
|
|
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); |
|
1578
|
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
with C<$sec>, C<$min>, and C<$hour> assigned-to but unused. There are |
|
1580
|
|
|
|
|
|
|
two ways I know of to eliminate these: |
|
1581
|
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
=head3 Assign to C<undef> |
|
1583
|
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
On the left-hand side of a list assignment, C<undef> causes the |
|
1585
|
|
|
|
|
|
|
corresponding right-hand value to be ignored. This makes our example |
|
1586
|
|
|
|
|
|
|
look like |
|
1587
|
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
# 0 1 2 3 4 5 |
|
1589
|
|
|
|
|
|
|
my (undef,undef,undef,$mday,$mon,$year) = localtime(); |
|
1590
|
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
=head2 Slice the Right-Hand Side |
|
1592
|
|
|
|
|
|
|
|
|
1593
|
|
|
|
|
|
|
The unwanted values can also be eliminated by slicing the right-hand |
|
1594
|
|
|
|
|
|
|
side of the assignment. This looks like |
|
1595
|
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
# 3 4 5 |
|
1597
|
|
|
|
|
|
|
my ($mday,$mon,$year) = ( localtime() )[ 3 .. 5 ]; |
|
1598
|
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
or, if you prefer, |
|
1600
|
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
# 3 4 5 |
|
1602
|
|
|
|
|
|
|
my ($mday,$mon,$year) = ( localtime() )[ 3, 4, 5 ]; |
|
1603
|
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
=head1 SUPPORT |
|
1605
|
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
Support is by the author. Please file bug reports at |
|
1607
|
|
|
|
|
|
|
L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Critic-Policy-Variables-ProhibitUnusedVarsStricter>, |
|
1608
|
|
|
|
|
|
|
L<https://github.com/trwyant/perl-Perl-Critic-Policy-Variables-ProhibitUnusedVarsStricter/issues>, or in |
|
1609
|
|
|
|
|
|
|
electronic mail to the author. |
|
1610
|
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1612
|
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
Thomas R. Wyant, III F<wyant at cpan dot org> |
|
1614
|
|
|
|
|
|
|
|
|
1615
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
1616
|
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
Copyright (C) 2012-2022 Thomas R. Wyant, III |
|
1618
|
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
=head1 LICENSE |
|
1620
|
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
|
1622
|
|
|
|
|
|
|
under the same terms as Perl 5.10.0. For more details, see the full text |
|
1623
|
|
|
|
|
|
|
of the licenses in the directory LICENSES. |
|
1624
|
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but |
|
1626
|
|
|
|
|
|
|
without any warranty; without even the implied warranty of |
|
1627
|
|
|
|
|
|
|
merchantability or fitness for a particular purpose. |
|
1628
|
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
=cut |
|
1630
|
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
# Local Variables: |
|
1632
|
|
|
|
|
|
|
# mode: cperl |
|
1633
|
|
|
|
|
|
|
# cperl-indent-level: 4 |
|
1634
|
|
|
|
|
|
|
# fill-column: 72 |
|
1635
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
|
1636
|
|
|
|
|
|
|
# c-indentation-style: bsd |
|
1637
|
|
|
|
|
|
|
# End: |
|
1638
|
|
|
|
|
|
|
# ex: set ts=8 sts=4 sw=4 tw=72 ft=perl expandtab shiftround : |