package B::Lint;
+our $VERSION = '1.03';
+
=head1 NAME
B::Lint - Perl lint
=head1 DESCRIPTION
The B::Lint module is equivalent to an extended version of the B<-w>
-option of B<perl>. It is named after the program B<lint> which carries
+option of B<perl>. It is named after the program F<lint> which carries
out a similar process for C programs.
=head1 OPTIONS AND LINT CHECKS
$foo = length(@bar);
$foo = @bar;
+
will elicit a warning. Using an explicit B<scalar()> silences the
warning. For example,
for (@a) { ... }
+=item B<bare-subs>
+
+This option warns whenever a bareword is implicitly quoted, but is also
+the name of a subroutine in the current package. Typical mistakes that it will
+trap are:
+
+ use constant foo => 'bar';
+ @a = ( foo => 1 );
+ $b{foo} = 2;
+
+Neither of these will do what a naive user would expect.
+
=item B<dollar-underscore>
-This option warns whenever $_ is used either explicitly anywhere or
+This option warns whenever C<$_> is used either explicitly anywhere or
as the implicit argument of a B<print> statement.
=item B<private-names>
This option warns on each use of any variable, subroutine or
method name that lives in a non-current package but begins with
an underscore ("_"). Warnings aren't issued for the special case
-of the single character name "_" by itself (e.g. $_ and @_).
+of the single character name "_" by itself (e.g. C<$_> and C<@_>).
=item B<undefined-subs>
=item B<regexp-variables>
-This option warns whenever one of the regexp variables $', $& or
-$' is used. Any occurrence of any of these variables in your
+This option warns whenever one of the regexp variables C<$`>, C<$&> or C<$'>
+is used. Any occurrence of any of these variables in your
program can slow your whole program down. See L<perlre> for
details.
This is only a very preliminary version.
+This module doesn't work correctly on thread-enabled perls.
+
=head1 AUTHOR
Malcolm Beattie, mbeattie@sable.ox.ac.uk.
=cut
use strict;
-use B qw(walkoptree_slow main_root walksymtable svref_2object parents);
-
-# Constants (should probably be elsewhere)
-sub G_ARRAY () { 1 }
-sub OPf_LIST () { 1 }
-sub OPf_KNOW () { 2 }
-sub OPf_STACKED () { 64 }
+use B qw(walkoptree_slow main_root walksymtable svref_2object parents
+ OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY SVf_POK
+ );
my $file = "unknown"; # shadows current filename
my $line = 0; # shadows current line number
my %implies_ok_context;
BEGIN {
map($implies_ok_context{$_}++,
- qw(pp_scalar pp_av2arylen pp_aelem pp_aslice pp_helem pp_hslice
- pp_keys pp_values pp_hslice pp_defined pp_undef pp_delete));
+ qw(scalar av2arylen aelem aslice helem hslice
+ keys values hslice defined undef delete));
}
# Lint checks turned on by default
BEGIN {
map($valid_check{$_}++,
qw(context implicit_read implicit_write dollar_underscore
- private_names undefined_subs regexp_variables));
+ private_names bare_subs undefined_subs regexp_variables));
}
# Debugging options
sub gimme {
my $op = shift;
my $flags = $op->flags;
- if ($flags & OPf_KNOW) {
- return(($flags & OPf_LIST) ? 1 : 0);
+ if ($flags & OPf_WANT) {
+ return(($flags & OPf_WANT) == OPf_WANT_LIST ? 1 : 0);
}
return undef;
}
sub B::COP::lint {
my $op = shift;
- if ($op->ppaddr eq "pp_nextstate") {
- $file = $op->filegv->SV->PV;
+ if ($op->name eq "nextstate") {
+ $file = $op->file;
$line = $op->line;
$curstash = $op->stash->NAME;
}
sub B::UNOP::lint {
my $op = shift;
- my $ppaddr = $op->ppaddr;
- if ($check{context} && ($ppaddr eq "pp_rv2av" || $ppaddr eq "pp_rv2hv")) {
+ my $opname = $op->name;
+ if ($check{context} && ($opname eq "rv2av" || $opname eq "rv2hv")) {
my $parent = parents->[0];
- my $pname = $parent->ppaddr;
+ my $pname = $parent->name;
return if gimme($op) || $implies_ok_context{$pname};
# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
# null out the parent so we have to check for a parent of pp_null and
# a grandparent of pp_enteriter or pp_delete
- if ($pname eq "pp_null") {
- my $gpname = parents->[1]->ppaddr;
- return if $gpname eq "pp_enteriter" || $gpname eq "pp_delete";
+ if ($pname eq "null") {
+ my $gpname = parents->[1]->name;
+ return if $gpname eq "enteriter" || $gpname eq "delete";
}
warning("Implicit scalar context for %s in %s",
- $ppaddr eq "pp_rv2av" ? "array" : "hash", $parent->desc);
+ $opname eq "rv2av" ? "array" : "hash", $parent->desc);
}
- if ($check{private_names} && $ppaddr eq "pp_method") {
+ if ($check{private_names} && $opname eq "method") {
my $methop = $op->first;
- if ($methop->ppaddr eq "pp_const") {
+ if ($methop->name eq "const") {
my $method = $methop->sv->PV;
if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
warning("Illegal reference to private method name $method");
sub B::PMOP::lint {
my $op = shift;
if ($check{implicit_read}) {
- my $ppaddr = $op->ppaddr;
- if ($ppaddr eq "pp_match" && !($op->flags & OPf_STACKED)) {
+ if ($op->name eq "match" && !($op->flags & OPf_STACKED)) {
warning('Implicit match on $_');
}
}
if ($check{implicit_write}) {
- my $ppaddr = $op->ppaddr;
- if ($ppaddr eq "pp_subst" && !($op->flags & OPf_STACKED)) {
+ if ($op->name eq "subst" && !($op->flags & OPf_STACKED)) {
warning('Implicit substitution on $_');
}
}
sub B::LOOP::lint {
my $op = shift;
if ($check{implicit_read} || $check{implicit_write}) {
- my $ppaddr = $op->ppaddr;
- if ($ppaddr eq "pp_enteriter") {
+ if ($op->name eq "enteriter") {
my $last = $op->last;
- if ($last->ppaddr eq "pp_gv" && $last->gv->NAME eq "_") {
+ if ($last->name eq "gv" && $last->gv->NAME eq "_") {
warning('Implicit use of $_ in foreach');
}
}
}
}
-sub B::GVOP::lint {
+sub B::SVOP::lint {
my $op = shift;
- if ($check{dollar_underscore} && $op->ppaddr eq "pp_gvsv"
+ if ( $check{bare_subs} && $op->name eq 'const'
+ && $op->private & 64 ) # OPpCONST_BARE = 64 in op.h
+ {
+ my $sv = $op->sv;
+ if( $sv->FLAGS & SVf_POK && exists &{$curstash.'::'.$sv->PV} ) {
+ warning "Bare sub name '" . $sv->PV . "' interpreted as string";
+ }
+ }
+ if ($check{dollar_underscore} && $op->name eq "gvsv"
&& $op->gv->NAME eq "_")
{
warning('Use of $_');
}
if ($check{private_names}) {
- my $ppaddr = $op->ppaddr;
- my $gv = $op->gv;
- if (($ppaddr eq "pp_gv" || $ppaddr eq "pp_gvsv")
- && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash)
- {
- warning('Illegal reference to private name %s', $gv->NAME);
+ my $opname = $op->name;
+ if ($opname eq "gv" || $opname eq "gvsv") {
+ my $gv = $op->gv;
+ if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) {
+ warning('Illegal reference to private name %s', $gv->NAME);
+ }
+ } elsif ($opname eq "method_named") {
+ my $method = $op->gv->PV;
+ if ($method =~ /^_./) {
+ warning("Illegal reference to private method name $method");
+ }
}
}
if ($check{undefined_subs}) {
- if ($op->ppaddr eq "pp_gv" && $op->next->ppaddr eq "pp_entersub") {
+ if ($op->name eq "gv"
+ && $op->next->name eq "entersub")
+ {
my $gv = $op->gv;
my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
no strict 'refs';
}
}
}
- if ($check{regexp_variables} && $op->ppaddr eq "pp_gvsv") {
+ if ($check{regexp_variables} && $op->name eq "gvsv") {
my $name = $op->gv->NAME;
if ($name =~ /^[&'`]$/) {
warning('Use of regexp variable $%s', $name);
# Now do subs in main
no strict qw(vars refs);
- my $sym;
local(*glob);
- while (($sym, *glob) = each %{"main::"}) {
- #warn "Trying $sym\n";#debug
- svref_2object(\*glob)->EGV->lintcv unless $sym =~ /::$/;
+ for my $sym (keys %main::) {
+ next if $sym =~ /::$/;
+ *glob = $main::{$sym};
+ svref_2object(\*glob)->EGV->lintcv;
}
# Now do subs in non-main packages given by -u options
%check = ();
}
else {
- if ($opt =~ s/^no-//) {
+ if ($opt =~ s/^no_//) {
$check{$opt} = 0;
}
else {
projects / p5sagit/p5-mst-13.2.git / blobdiff