File Coverage

blib/lib/Perl/Critic/Policy/Variables/ProhibitReusedNames.pm
Criterion Covered Total %
statement 50 50 100.0
branch 13 14 92.8
condition 2 3 66.6
subroutine 13 13 100.0
pod 4 5 80.0
total 82 85 96.4


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Variables::ProhibitReusedNames;
2              
3 40     40   28751 use 5.010001;
  40         194  
4 40     40   268 use strict;
  40         140  
  40         897  
5 40     40   247 use warnings;
  40         124  
  40         1148  
6 40     40   262 use List::SomeUtils qw(part);
  40         137  
  40         1982  
7 40     40   275 use Readonly;
  40         115  
  40         1918  
8              
9 40     40   272 use Perl::Critic::Utils qw{ :severities :classification :data_conversion };
  40         137  
  40         2043  
10 40     40   15600 use parent 'Perl::Critic::Policy';
  40         158  
  40         252  
11              
12             our $VERSION = '1.146';
13              
14             #-----------------------------------------------------------------------------
15              
16             Readonly::Scalar my $DESC => q{Reused variable name in lexical scope: };
17             Readonly::Scalar my $EXPL => q{Invent unique variable names};
18              
19             #-----------------------------------------------------------------------------
20              
21             sub supported_parameters {
22             return (
23             {
24 108     108 0 2189 name => 'allow',
25             description => 'The variables to not consider as duplicates.',
26             default_string => '$self $class', ## no critic (RequireInterpolationOfMetachars)
27             behavior => 'string list',
28             },
29             );
30             }
31              
32 100     100 1 447 sub default_severity { return $SEVERITY_MEDIUM }
33 74     74 1 362 sub default_themes { return qw( core bugs ) }
34 19     19 1 78 sub applies_to { return 'PPI::Statement::Variable' }
35              
36             #-----------------------------------------------------------------------------
37              
38             sub violates {
39 58     58 1 157 my ( $self, $elem, undef ) = @_;
40 58 50       208 return if 'local' eq $elem->type;
41              
42 58         2306 my $allow = $self->{_allow};
43 58         187 my $names = [ grep { not $allow->{$_} } $elem->variables() ];
  62         2853  
44             # Assert: it is impossible for @$names to be empty in valid Perl syntax
45             # But if it IS empty, this code should still work but will be inefficient
46              
47             # Walk up the PDOM looking for declared variables in the same
48             # scope or outer scopes. Quit when we hit the root or when we find
49             # violations for all vars (the latter is a shortcut).
50 58         219 my $outer = $elem;
51 58         122 my @violations;
52 58         134 while (1) {
53 273         798 my $up = $outer->sprevious_sibling;
54 273 100       6422 if (not $up) {
55 166         496 $up = $outer->parent;
56 166 100       905 last if !$up; # top of PDOM, we're done
57             }
58 237         424 $outer = $up;
59              
60 237 100 66     1008 if ($outer->isa('PPI::Statement::Variable') && 'local' ne $outer->type) {
61 43         1588 my %vars = map {$_ => undef} $outer->variables;
  50         2008  
62 43         115 my $hits;
63 43 100   44   252 ($hits, $names) = part { exists $vars{$_} ? 0 : 1 } @{$names};
  44         231  
  43         193  
64 43 100       231 if ($hits) {
65 24         49 push @violations, map { $self->violation( $DESC . $_, $EXPL, $elem ) } @{$hits};
  26         188  
  24         61  
66 24 100       126 last if not $names; # found violations for ALL variables, we're done
67             }
68             }
69             }
70 58         245 return @violations;
71             }
72              
73             1;
74              
75             __END__
76              
77             #-----------------------------------------------------------------------------
78              
79             =pod
80              
81             =head1 NAME
82              
83             Perl::Critic::Policy::Variables::ProhibitReusedNames - Do not reuse a variable name in a lexical scope
84              
85              
86             =head1 AFFILIATION
87              
88             This Policy is part of the core L<Perl::Critic|Perl::Critic>
89             distribution.
90              
91              
92             =head1 DESCRIPTION
93              
94             It's really hard on future maintenance programmers if you reuse a
95             variable name in a lexical scope. The programmer is at risk of
96             confusing which variable is which. And, worse, the programmer could
97             accidentally remove the inner declaration, thus silently changing the
98             meaning of the inner code to use the outer variable.
99              
100             my $x = 1;
101             for my $i (0 .. 10) {
102             my $x = $i+1; # not OK, "$x" reused
103             }
104              
105             With C<use warnings> in effect, Perl will warn you if you reuse a
106             variable name at the same scope level but not within nested scopes. Like so:
107              
108             % perl -we 'my $x; my $x'
109             "my" variable $x masks earlier declaration in same scope at -e line 1.
110              
111             This policy takes that warning to a stricter level.
112              
113              
114             =head1 CAVEATS
115              
116             =head2 Crossing subroutines
117              
118             This policy looks across subroutine boundaries. So, the following may
119             be a false positive for you:
120              
121             sub make_accessor {
122             my ($self, $fieldname) = @_;
123             return sub {
124             my ($self) = @_; # false positive, $self declared as reused
125             return $self->{$fieldname};
126             }
127             }
128              
129             This is intentional, though, because it catches bugs like this:
130              
131             my $debug_mode = 0;
132             sub set_debug {
133             my $debug_mode = 1; # accidental redeclaration
134             }
135              
136             I've done this myself several times -- it's a strong habit to put that
137             "my" in front of variables at the start of subroutines.
138              
139              
140             =head2 Performance
141              
142             The current implementation walks the tree over and over. For a big
143             file, this can be a huge time sink. I'm considering rewriting to
144             search the document just once for variable declarations and cache the
145             tree walking on that single analysis.
146              
147              
148             =head1 CONFIGURATION
149              
150             This policy has a single option, C<allow>, which is a list of names to
151             never count as duplicates. It defaults to containing C<$self> and
152             C<$class>. You add to this by adding something like this to your
153             F<.perlcriticrc>:
154              
155             [Variables::ProhibitReusedNames]
156             allow = $self $class @blah
157              
158              
159             =head1 AUTHOR
160              
161             Chris Dolan <cdolan@cpan.org>
162              
163             This policy is inspired by
164             L<http://use.perl.org/~jdavidb/journal/37548>. Java does not allow
165             you to reuse variable names declared in outer scopes, which I think is
166             a nice feature.
167              
168             =head1 COPYRIGHT
169              
170             Copyright (c) 2008-2021 Chris Dolan
171              
172             This program is free software; you can redistribute it and/or modify
173             it under the same terms as Perl itself. The full text of this license
174             can be found in the LICENSE file included with this module.
175              
176             =cut
177              
178             # Local Variables:
179             # mode: cperl
180             # cperl-indent-level: 4
181             # fill-column: 78
182             # indent-tabs-mode: nil
183             # c-indentation-style: bsd
184             # End:
185             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :