package B::Xref;
+our $VERSION = '1.00';
+
=head1 NAME
B::Xref - Generates cross reference reports for Perl programs
=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
);
sub UNKNOWN { ["?", "?", "?"] }
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];
my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
$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];
+ }
+ }
}
sub xref {
sub pp_nextstate {
my $op = shift;
- $file = $op->filegv->SV->PV;
+ $file = $op->file;
$line = $op->line;
$top = UNKNOWN;
}
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) ? $sv->PV : "?"];
+ }
+ else {
+ $top = $pad[$op->targ];
+ $top = UNKNOWN unless $top;
+ }
}
sub pp_method {
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);
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");
}
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);