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   29151 use 5.010001;
  40         192  
4 40     40   273 use strict;
  40         120  
  40         860  
5 40     40   220 use warnings;
  40         105  
  40         1154  
6 40     40   242 use List::SomeUtils qw(part);
  40         133  
  40         1895  
7 40     40   268 use Readonly;
  40         105  
  40         1870  
8              
9 40     40   315 use Perl::Critic::Utils qw{ :severities :classification :data_conversion };
  40         119  
  40         2023  
10 40     40   14981 use parent 'Perl::Critic::Policy';
  40         128  
  40         283  
11              
12             our $VERSION = '1.148';
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 2152 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 445 sub default_severity { return $SEVERITY_MEDIUM }
33 74     74 1 281 sub default_themes { return qw( core bugs ) }
34 19     19 1 67 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       184 return if 'local' eq $elem->type;
41              
42 58         2072 my $allow = $self->{_allow};
43 58         177 my $names = [ grep { not $allow->{$_} } $elem->variables() ];
  62         2602  
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         183 my $outer = $elem;
51 58         108 my @violations;
52 58         104 while (1) {
53 273         700 my $up = $outer->sprevious_sibling;
54 273 100       5708 if (not $up) {
55 166         402 $up = $outer->parent;
56 166 100       834 last if !$up; # top of PDOM, we're done
57             }
58 237         369 $outer = $up;
59              
60 237 100 66     912 if ($outer->isa('PPI::Statement::Variable') && 'local' ne $outer->type) {
61 43         1418 my %vars = map {$_ => undef} $outer->variables;
  50         1918  
62 43         115 my $hits;
63 43 100   44   176 ($hits, $names) = part { exists $vars{$_} ? 0 : 1 } @{$names};
  44         203  
  43         188  
64 43 100       217 if ($hits) {
65 24         47 push @violations, map { $self->violation( $DESC . $_, $EXPL, $elem ) } @{$hits};
  26         154  
  24         57  
66 24 100       124 last if not $names; # found violations for ALL variables, we're done
67             }
68             }
69             }
70 58         237 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 :