Login
New policy Variables::ProhibitReusedVarNames
authorChris Dolan <chris+github@chrisdolan.net>
Sun, 28 Sep 2008 04:47:12 +0000 (04:47 +0000)
committerChris Dolan <chris+github@chrisdolan.net>
Sun, 28 Sep 2008 04:47:12 +0000 (04:47 +0000)
lib/Perl/Critic/Policy/Variables/ProhibitReusedVarNames.pm [new file with mode: 0644]
t/Variables/ProhibitReusedVarNames.run [new file with mode: 0644]
t/Variables/ProhibitUnusedVariables.run

diff --git a/lib/Perl/Critic/Policy/Variables/ProhibitReusedVarNames.pm b/lib/Perl/Critic/Policy/Variables/ProhibitReusedVarNames.pm
new file mode 100644 (file)
index 0000000..557a2bd
--- /dev/null
@@ -0,0 +1,179 @@
+##############################################################################
+#      $URL$
+#     $Date$
+#   $Author$
+# $Revision$
+##############################################################################
+
+package Perl::Critic::Policy::Variables::ProhibitReusedVarNames;
+
+use 5.006001;
+use strict;
+use warnings;
+use List::MoreUtils qw(part);
+use Readonly;
+
+use Perl::Critic::Utils qw{ :severities :classification :data_conversion };
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '1.093_01';
+
+#-----------------------------------------------------------------------------
+
+Readonly::Scalar my $DESC => q{Reused variable name in lexical scope: };
+Readonly::Scalar my $EXPL => q{Invent unique variable names};
+
+#-----------------------------------------------------------------------------
+
+sub supported_parameters { return ()                         }
+sub default_severity     { return $SEVERITY_MEDIUM           }
+sub default_themes       { return qw( core bugs )            }
+sub applies_to           { return 'PPI::Statement::Variable' }
+
+#-----------------------------------------------------------------------------
+
+sub violates {
+    my ( $self, $elem, undef ) = @_;
+    return if 'local' eq $elem->type;
+
+    my $names = [$elem->variables];
+    # Assert: it is impossible for @$names to be empty in valid Perl syntax
+    # But if it IS empty, this code should still work but will be inefficient
+
+    # walk up the PDOM looking for declared variables in the same
+    # scope or outer scopes quit when we hit the root or when we find
+    # violations for all vars (the latter is a shortcut)
+    my $outer = $elem;
+    my @violations;
+    while (1) {
+       my $up = $outer->sprevious_sibling;
+       if (! defined $up) {
+          $up = $outer->parent;
+       }
+       last if ! defined $up; # top of PDOM, we're done
+       $outer = $up;
+
+       if ($outer->isa('PPI::Statement::Variable') && 'local' ne $outer->type) {
+          my %vars = map {$_ => undef} $outer->variables;
+          my $hits;
+          ($hits, $names) = part { exists $vars{$_} ? 0 : 1 } @$names;
+          if ($hits) {
+             push @violations, map { $self->violation( $DESC . $_, $EXPL, $elem ) } @{$hits};
+             last if !$names;  # found violations for ALL variables, we're done
+          }
+       }
+    }
+    return @violations;
+}
+
+1;
+
+__END__
+
+#-----------------------------------------------------------------------------
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Variables::ProhibitReusedVarNames - Do not reuse a variable name in a lexical scope
+
+
+=head1 AFFILIATION
+
+This Policy is part of the core L<Perl::Critic|Perl::Critic>
+distribution.
+
+
+=head1 DESCRIPTION
+
+It's really hard on future maintenance programmers if you reuse a
+variable name in a lexical scope. The programmer is at risk of
+confusing which variable is which. And, worse, the programmer could
+accidentally remov the inner declaration, thus silently changing the
+meaning of the inner code to use the outer variable.
+
+   my $x = 1;
+   for my $i (0 .. 10) {
+      my $x = $i+1;  # not OK, "$x" reused
+   }
+
+With C<use warnings> in effect, Perl will warn you if you reuse a
+variable name at the same scope level but not within nested scopes.  Like so:
+
+    % perl -we 'my $x; my $x'
+    "my" variable $x masks earlier declaration in same scope at -e line 1.
+
+This policy takes that warning to a stricter level.
+
+
+=head1 CAVEATS
+
+=head2 Crossing subroutines
+
+This policy looks across subroutine boundaries.  So, the following may
+be a false positive for you:
+
+    sub make_accessor {
+        my ($self, $fieldname) = @_;
+        return sub {
+            my ($self) = @_;  # false positive, $self declared as reused
+            return $self->{$fieldname};
+        }
+    }
+
+This is intentional, though, because it catches bugs like this:
+
+    my $debug_mode = 0;
+    sub set_debug {
+       my $debug_mode = 1;  # accidental redeclaration
+    }
+
+I've done this myself several times -- it's a strong habit to put that
+"my" in front of variables at the start of subroutines.
+
+If you have opinions on this caveat/feature please post to the
+L<Perl::Critic> mailing list.  Perhaps we'll add some specific
+exemptions?
+
+
+=head2 Performance
+
+The current implementation walks the tree over and over.  For a big
+file, this can be a huge time sink.  I'm considering rewriting to
+search the document just once for variable declarations and cache the
+tree walking on that single analysis.
+
+
+=head1 CONFIGURATION
+
+This Policy is not configurable except for the standard options.
+
+
+=head1 AUTHOR
+
+Chris Dolan <cdolan@cpan.org>
+
+This policy is inspired by
+L<http://use.perl.org/~jdavidb/journal/37548>.  Java does not allow
+you to reuse variable names declared in outer scopes, which I think is
+a nice feature.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Chris Dolan
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.  The full text of this license
+can be found in the LICENSE file included with this module.
+
+=cut
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
diff --git a/t/Variables/ProhibitReusedVarNames.run b/t/Variables/ProhibitReusedVarNames.run
new file mode 100644 (file)
index 0000000..8b10b49
--- /dev/null
@@ -0,0 +1,253 @@
+## name Simple block
+## failures 2
+## cut
+
+my $x;
+{
+    my $x;
+}
+
+sub foo {
+    my $i;
+    {
+        my $i;
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name Array
+## failures 1
+## cut
+
+my @x;
+{
+    my @x;
+}
+
+#-----------------------------------------------------------------------------
+
+## name Hash
+## failures 1
+## cut
+
+my %x;
+{
+    my %x;
+}
+
+#-----------------------------------------------------------------------------
+
+## name Outer bleeds into sub
+## failures 3
+## cut
+
+my $x;
+{
+    my $x;
+}
+
+sub foo {
+    my $x;
+    {
+        my $x;
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name Reversed scope
+## failures 0
+## cut
+
+{
+    my $x;
+}
+my $x;
+
+sub foo {
+    {
+        my $i;
+    }
+    my $i;
+}
+
+#-----------------------------------------------------------------------------
+
+## name Our
+## failures 2
+## cut
+
+our $x;
+{
+    our $x;
+}
+
+sub foo {
+    our $i;
+    {
+        our $i;
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name Our vs. my
+## failures 2
+## cut
+
+our $x;
+{
+    my $x;
+}
+
+sub foo {
+    our $i;
+    {
+        my $i;
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name Same scope
+## failures 2
+## cut
+
+my $x;
+my $x;
+
+sub foo {
+    my $i;
+    my $i;
+}
+
+#-----------------------------------------------------------------------------
+
+## name Conditional block
+## failures 2
+## cut
+
+my $x;
+if (1) {
+    my $x;
+}
+
+sub foo {
+    my $i;
+    if (1) {
+        my $i;
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name For loop
+## failures 2
+## cut
+
+my $x;
+for my $y (0..10) {
+    my $x;
+}
+
+sub foo {
+    my $i;
+    for my $z (0..10) {
+        my $i;
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name While loop
+## failures 2
+## cut
+
+my $x;
+while (1) {
+    my $x;
+}
+
+sub foo {
+    my $i;
+    while (1) {
+        my $i;
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name Deep block
+## failures 2
+## cut
+
+my $x;
+for (0..5) {
+    while (1) {
+        if (foo()) {
+            {
+                my $x;
+            }
+        }
+    }
+}
+
+sub foo {
+    my $i;
+    for (0..5) {
+        while (1) {
+            if (foo()) {
+                {
+                    my $i;
+                }
+            }
+        }
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name Other "my" syntax
+## failures 4
+## cut
+
+my $x;
+{
+    my ($x, $y, @z);
+    {
+        my ($x, $y, @z, $w);
+        {
+            my (@w);
+        }
+    }
+}
+
+#-----------------------------------------------------------------------------
+
+## name Empty "my" (which is invalid Perl syntax, but supported)
+## failures 0
+## cut
+
+my $x;
+{
+    my ();
+}
+
+#-----------------------------------------------------------------------------
+
+##############################################################################
+#      $URL$
+#     $Date$
+#   $Author$
+# $Revision$
+##############################################################################
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
index 0cb3da0..4654949 100644 (file)
@@ -115,6 +115,23 @@ my $x = 2;
 
 #-----------------------------------------------------------------------------
 
+## name Closures
+## failures 0
+## cut
+
+{
+   my $has_graphviz = undef;
+
+   sub has_graphviz {
+      if (!defined $has_graphviz) {
+         $has_graphviz = eval { require GraphViz; 1; } ? 1 : 0;
+      }
+      return $has_graphviz;
+   }
+}
+
+#-----------------------------------------------------------------------------
+
 ##############################################################################
 #      $URL$
 #     $Date$