From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Date: Tue, 2 Sep 1997 15:54:27 +0000 (+0000)
Subject: Added private-names option.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1b95b982db38b55c080b1a1a3872fba1ac114acc;p=p5sagit%2Fp5-mst-13.2.git

Added private-names option.

p4raw-id: //depot/perlext/Compiler@48
---

diff --git a/B/Lint.pm b/B/Lint.pm
index fdf955d..4e34545 100644
--- a/B/Lint.pm
+++ b/B/Lint.pm
@@ -55,11 +55,18 @@ Both B<implicit-read> and B<implicit-write> warn about this:
 
     for (@a) { ... }
 
-=item B<dollar_underscore>
+=item B<dollar-underscore>
 
 This option warns whenever $_ 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 a variable or subroutine 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 @_).
+
 =item B<all>
 
 Turn all warnings on.
@@ -103,6 +110,7 @@ sub OPf_STACKED () { 64 }
 
 my $file = "unknown";		# shadows current filename
 my $line = 0;			# shadows current line number
+my $curstash = "main";		# shadows current stash
 
 # Lint checks
 my %check;
@@ -120,7 +128,8 @@ my %valid_check;
 # All valid checks
 BEGIN {
     map($valid_check{$_}++,
-	qw(context implicit_read implicit_write dollar_underscore));
+	qw(context implicit_read implicit_write dollar_underscore
+	   private_names));
 }
 
 # Debugging options
@@ -153,6 +162,7 @@ sub B::COP::lint {
     if ($op->ppaddr eq "pp_nextstate") {
 	$file = $op->filegv->SV->PV;
 	$line = $op->line;
+	$curstash = $op->stash->NAME;
     }
 }
 
@@ -207,9 +217,19 @@ sub B::LOOP::lint {
 sub B::GVOP::lint {
     my $op = shift;
     if ($check{dollar_underscore} && $op->ppaddr eq "pp_gvsv"
-	&& $op->gv->NAME eq "_") {
+	&& $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);
+	}
+    }
 }
 
 sub B::GV::lintcv {