File Coverage

blib/lib/Perl/Critic/Policy/Variables/ProhibitReusedNames.pm
Criterion Covered Total %
statement 24 50 48.0
branch 0 14 0.0
condition 0 3 0.0
subroutine 11 13 84.6
pod 4 5 80.0
total 39 85 45.8


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Variables::ProhibitReusedNames;
2              
3 40     40   27476 use 5.010001;
  40         177  
4 40     40   269 use strict;
  40         148  
  40         864  
5 40     40   219 use warnings;
  40         102  
  40         1112  
6 40     40   270 use List::SomeUtils qw(part);
  40         140  
  40         1913  
7 40     40   259 use Readonly;
  40         165  
  40         1716  
8              
9 40     40   274 use Perl::Critic::Utils qw{ :severities :classification :data_conversion };
  40         107  
  40         2013  
10 40     40   14889 use parent 'Perl::Critic::Policy';
  40         111  
  40         259  
11              
12             our $VERSION = '1.150';
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 90     90 0 1964 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 74     74 1 324 sub default_severity { return $SEVERITY_MEDIUM }
33 74     74 1 322 sub default_themes { return qw( core bugs ) }
34 1     1 1 5 sub applies_to { return 'PPI::Statement::Variable' }
35              
36             #-----------------------------------------------------------------------------
37              
38             sub violates {
39 0     0 1   my ( $self, $elem, undef ) = @_;
40 0 0         return if 'local' eq $elem->type;
41              
42 0           my $allow = $self->{_allow};
43 0           my $names = [ grep { not $allow->{$_} } $elem->variables() ];
  0            
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 0           my $outer = $elem;
51 0           my @violations;
52 0           while (1) {
53 0           my $up = $outer->sprevious_sibling;
54 0 0         if (not $up) {
55 0           $up = $outer->parent;
56 0 0         last if !$up; # top of PDOM, we're done
57             }
58 0           $outer = $up;
59              
60 0 0 0       if ($outer->isa('PPI::Statement::Variable') && 'local' ne $outer->type) {
61 0           my %vars = map {$_ => undef} $outer->variables;
  0            
62 0           my $hits;
63 0 0   0     ($hits, $names) = part { exists $vars{$_} ? 0 : 1 } @{$names};
  0            
  0            
64 0 0         if ($hits) {
65 0           push @violations, map { $self->violation( $DESC . $_, $EXPL, $elem ) } @{$hits};
  0            
  0            
66 0 0         last if not $names; # found violations for ALL variables, we're done
67             }
68             }
69             }
70 0           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 :