New B::Lint option, bare-subs, that checks for implicitely

       quoted barewords that are also subroutines, from
       Ian Phillipps <ip@tarragon-et.co.uk>.
       Message-ID: <20021107122909.A11199@bob.tarragon-et.co.uk>
       With a few tweaks to the implementation and tests.
(previous change was empty)

p4raw-id: //depot/perl@18149

2 files changed, 31 insertions, 4 deletions

diff --git a/ext/B/B/Lint.pm b/ext/B/B/Lint.pm
index 9a977c8041..af82a1a4e8 100644
--- a/ext/B/B/Lint.pm
+++ b/ext/B/B/Lint.pm
@@ -57,6 +57,18 @@ Both B<implicit-read> and B<implicit-write> warn about this:
 
     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
@@ -121,7 +133,7 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk.
 
 use strict;
 use B qw(walkoptree_slow main_root walksymtable svref_2object parents
-         OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY
+         OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY SVf_POK
         );
 
 my $file = "unknown";		# shadows current filename
@@ -145,7 +157,7 @@ my %valid_check;
 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
@@ -238,6 +250,14 @@ sub B::LOOP::lint {
 
 sub B::SVOP::lint {
     my $op = shift;
+    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 "_")
     {
diff --git a/ext/B/t/lint.t b/ext/B/t/lint.t
index 2d4e680d03..3c71bdc718 100644
--- a/ext/B/t/lint.t
+++ b/ext/B/t/lint.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 13;
+plan tests => 15; # adjust also number of skipped tests !
 
 # Runs a separate perl interpreter with the appropriate lint options
 # turned on
@@ -40,7 +40,7 @@ RESULT
 SKIP : {
 
     use Config;
-    skip("Doesn't work with threaded perls",9)
+    skip("Doesn't work with threaded perls",11)
        if $Config{useithreads};
 
     runlint 'implicit-read', '1 for @ARGV', <<'RESULT', 'implicit-read in foreach';
@@ -80,4 +80,11 @@ RESULT
 Use of regexp variable $& at -e line 1
 RESULT
 
+    runlint 'bare-subs', 'sub bare(){1};$x=bare', '';
+
+    runlint 'bare-subs', 'sub bare(){1}; $x=[bare=>0]; $x=$y{bare}', <<'RESULT';
+Bare sub name 'bare' interpreted as string at -e line 1
+Bare sub name 'bare' interpreted as string at -e line 1
+RESULT
+
 }