X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB%2FLint.pm;h=1510d365cdc9254475974a498075a8546060ad8d;hb=1f01d15689eebf8cac0437bd6198b0ee0e3a2c33;hp=d34bd7792bcaaec74b3a42afb29f46dff35c934f;hpb=a798dbf2f5009fe67f7460a594ffd57a76c0fa98;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/B/B/Lint.pm b/ext/B/B/Lint.pm
index d34bd77..1510d36 100644
--- a/ext/B/B/Lint.pm
+++ b/ext/B/B/Lint.pm
@@ -1,5 +1,7 @@
 package B::Lint;
 
+our $VERSION = '1.01';
+
 =head1 NAME
 
 B::Lint - Perl lint
@@ -116,13 +118,9 @@ 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
+        );
 
 my $file = "unknown";		# shadows current filename
 my $line = 0;			# shadows current line number
@@ -133,8 +131,8 @@ my %check;
 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
@@ -165,8 +163,8 @@ sub warning {
 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;
 }
@@ -175,8 +173,8 @@ sub B::OP::lint {}
 
 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;
     }
@@ -184,24 +182,24 @@ sub B::COP::lint {
 
 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");
@@ -213,14 +211,12 @@ sub B::UNOP::lint {
 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 $_');
 	}
     }
@@ -229,34 +225,35 @@ sub B::PMOP::lint {
 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{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);
+	    }
 	}
     }
     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';
@@ -266,7 +263,7 @@ sub B::GVOP::lint {
 	    }
 	}
     }
-    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);
@@ -350,7 +347,7 @@ sub compile {
 	    %check = ();
 	}
 	else {
-	    if ($opt =~ s/^no-//) {
+	    if ($opt =~ s/^no_//) {
 		$check{$opt} = 0;
 	    }
 	    else {