This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix a remaining B::Lint bug.
[perl5.git] / ext / B / B / Lint.pm
index 67abe3d..9a977c8 100644 (file)
@@ -1,5 +1,7 @@
 package B::Lint;
 
+our $VERSION = '1.01';
+
 =head1 NAME
 
 B::Lint - Perl lint
@@ -109,6 +111,8 @@ include other package names whose subs are then checked by Lint.
 
 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.
@@ -162,7 +166,7 @@ sub gimme {
     my $op = shift;
     my $flags = $op->flags;
     if ($flags & OPf_WANT) {
-       return(($flags & OPf_WANT_LIST) ? 1 : 0);
+       return(($flags & OPf_WANT) == OPf_WANT_LIST ? 1 : 0);
     }
     return undef;
 }
@@ -172,7 +176,7 @@ sub B::OP::lint {}
 sub B::COP::lint {
     my $op = shift;
     if ($op->name eq "nextstate") {
-       $file = $op->filegv->SV->PV;
+       $file = $op->file;
        $line = $op->line;
        $curstash = $op->stash->NAME;
     }
@@ -232,7 +236,7 @@ sub B::LOOP::lint {
     }
 }
 
-sub B::GVOP::lint {
+sub B::SVOP::lint {
     my $op = shift;
     if ($check{dollar_underscore} && $op->name eq "gvsv"
        && $op->gv->NAME eq "_")
@@ -241,11 +245,16 @@ sub B::GVOP::lint {
     }
     if ($check{private_names}) {
        my $opname = $op->name;
-       my $gv = $op->gv;
-       if (($opname eq "gv" || $opname eq "gvsv")
-           && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash)
-       {
-           warning('Illegal reference to private name %s', $gv->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}) {
@@ -286,11 +295,11 @@ sub do_lint {
     
     # 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
@@ -345,7 +354,7 @@ sub compile {
            %check = ();
        }
        else {
-           if ($opt =~ s/^no-//) {
+           if ($opt =~ s/^no_//) {
                $check{$opt} = 0;
            }
            else {