Make the removal of references to AvFLAGS in the B modules conditional

[p5sagit/p5-mst-13.2.git] / ext / B / B / Xref.pm

diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
index 16f25ff..f727dc7 100644 (file)
--- a/ext/B/B/Xref.pm
+++ b/ext/B/B/Xref.pm
@@ -1,5 +1,7 @@
 package B::Xref;
 
+our $VERSION = '1.01';
+
 =head1 NAME
 
 B::Xref - Generates cross reference reports for Perl programs
@@ -19,8 +21,8 @@ The report generated is in the following format:
     File filename1
       Subroutine subname1
        Package package1
-         object1        C<line numbers>
-         object2        C<line numbers>
+         object1        line numbers
+         object2        line numbers
          ...
        Package package2
        ...
@@ -62,6 +64,10 @@ Directs output to C<FILENAME> instead of standard output.
 Raw output. Instead of producing a human-readable report, outputs a line
 in machine-readable form for each definition/use of a variable/sub/format.
 
+=item C<-d>
+
+Don't output the "(definitions)" sections.
+
 =item C<-D[tO]>
 
 (Internal) debug options, probably only useful if C<-r> included.
@@ -85,8 +91,9 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk.
 =cut
 
 use strict;
+use Config;
 use B qw(peekop class comppadlist main_start svref_2object walksymtable
-         OPpLVAL_INTRO SVf_POK
+         OPpLVAL_INTRO SVf_POK OPpOUR_INTRO cstring
         );
 
 sub UNKNOWN { ["?", "?", "?"] }
@@ -133,16 +140,27 @@ sub process {
 
 sub load_pad {
     my $padlist = shift;
-    my ($namelistav, @namelist, $ix);
+    my ($namelistav, $vallistav, @namelist, $ix);
     @pad = ();
     return if class($padlist) eq "SPECIAL";
-    ($namelistav) = $padlist->ARRAY;
+    ($namelistav,$vallistav) = $padlist->ARRAY;
     @namelist = $namelistav->ARRAY;
     for ($ix = 1; $ix < @namelist; $ix++) {
        my $namesv = $namelist[$ix];
        next if class($namesv) eq "SPECIAL";
        my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
-       $pad[$ix] = ["(lexical)", $type, $name];
+       $pad[$ix] = ["(lexical)", $type || '?', $name || '?'];
+    }
+    if ($Config{useithreads}) {
+       my (@vallist);
+       @vallist = $vallistav->ARRAY;
+       for ($ix = 1; $ix < @vallist; $ix++) {
+           my $valsv = $vallist[$ix];
+           next unless class($valsv) eq "GV";
+           # these pad GVs don't have corresponding names, so same @pad
+           # array can be used without collisions
+           $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
+       }
     }
 }
 
@@ -153,23 +171,24 @@ sub xref {
        last if $done{$$op}++;
        warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
        warn peekop($op), "\n" if $debug_op;
-       my $ppname = $op->ppaddr;
-       if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
+       my $opname = $op->name;
+       if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
            xref($op->other);
-       } elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
+       } elsif ($opname eq "match" || $opname eq "subst") {
            xref($op->pmreplstart);
-       } elsif ($ppname eq "pp_substcont") {
+       } elsif ($opname eq "substcont") {
            xref($op->other->pmreplstart);
            $op = $op->other;
            redo;
-       } elsif ($ppname eq "pp_enterloop") {
+       } elsif ($opname eq "enterloop") {
            xref($op->redoop);
            xref($op->nextop);
            xref($op->lastop);
-       } elsif ($ppname eq "pp_subst") {
+       } elsif ($opname eq "subst") {
            xref($op->pmreplstart);
        } else {
            no strict 'refs';
+           my $ppname = "pp_$opname";
            &$ppname($op) if defined(&$ppname);
        }
     }
@@ -200,7 +219,7 @@ sub xref_main {
 
 sub pp_nextstate {
     my $op = shift;
-    $file = $op->filegv->SV->PV;
+    $file = $op->file;
     $line = $op->line;
     $top = UNKNOWN;
 }
@@ -215,36 +234,61 @@ sub pp_padav { pp_padsv(@_) }
 sub pp_padhv { pp_padsv(@_) }
 
 sub deref {
-    my ($var, $as) = @_;
+    my ($op, $var, $as) = @_;
     $var->[1] = $as . $var->[1];
-    process($var, "used");
+    process($var, $op->private & OPpOUR_INTRO ? "intro" : "used");
 }
 
-sub pp_rv2cv { deref($top, "&"); }
-sub pp_rv2hv { deref($top, "%"); }
-sub pp_rv2sv { deref($top, "\$"); }
-sub pp_rv2av { deref($top, "\@"); }
-sub pp_rv2gv { deref($top, "*"); }
+sub pp_rv2cv { deref(shift, $top, "&"); }
+sub pp_rv2hv { deref(shift, $top, "%"); }
+sub pp_rv2sv { deref(shift, $top, "\$"); }
+sub pp_rv2av { deref(shift, $top, "\@"); }
+sub pp_rv2gv { deref(shift, $top, "*"); }
 
 sub pp_gvsv {
     my $op = shift;
-    my $gv = $op->gv;
-    $top = [$gv->STASH->NAME, '$', $gv->NAME];
-    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+    my $gv;
+    if ($Config{useithreads}) {
+       $top = $pad[$op->padix];
+       $top = UNKNOWN unless $top;
+       $top->[1] = '$';
+    }
+    else {
+       $gv = $op->gv;
+       $top = [$gv->STASH->NAME, '$', $gv->SAFENAME];
+    }
+    process($top, $op->private & OPpLVAL_INTRO ||
+                  $op->private & OPpOUR_INTRO   ? "intro" : "used");
 }
 
 sub pp_gv {
     my $op = shift;
-    my $gv = $op->gv;
-    $top = [$gv->STASH->NAME, "*", $gv->NAME];
+    my $gv;
+    if ($Config{useithreads}) {
+       $top = $pad[$op->padix];
+       $top = UNKNOWN unless $top;
+       $top->[1] = '*';
+    }
+    else {
+       $gv = $op->gv;
+       $top = [$gv->STASH->NAME, "*", $gv->SAFENAME];
+    }
     process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
 }
 
 sub pp_const {
     my $op = shift;
     my $sv = $op->sv;
-    $top = ["?", "",
-           (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
+    # constant could be in the pad (under useithreads)
+    if ($$sv) {
+       $top = ["?", "",
+               (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK)
+               ? cstring($sv->PV) : "?"];
+    }
+    else {
+       $top = $pad[$op->targ];
+       $top = UNKNOWN unless $top;
+    }
 }
 
 sub pp_method {
@@ -271,7 +315,7 @@ sub B::GV::xref {
     my $cv = $gv->CV;
     if ($$cv) {
        #return if $done{$$cv}++;
-       $file = $gv->FILEGV->SV->PV;
+       $file = $gv->FILE;
        $line = $gv->LINE;
        process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
        push(@todo, $cv);
@@ -279,7 +323,7 @@ sub B::GV::xref {
     my $form = $gv->FORM;
     if ($$form) {
        return if $done{$$form}++;
-       $file = $gv->FILEGV->SV->PV;
+       $file = $gv->FILE;
        $line = $gv->LINE;
        process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
     }
@@ -289,8 +333,9 @@ sub xref_definitions {
     my ($pack, %exclude);
     return if $nodefs;
     $subname = "(definitions)";
-    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
-                     strict vars FileHandle Exporter Carp)) {
+    foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
+                     strict vars FileHandle Exporter Carp PerlIO::Layer
+                     attributes utf8 warnings)) {
         $exclude{$pack."::"} = 1;
     }
     no strict qw(vars refs);