From: Rafael Garcia-Suarez Date: Wed, 13 Mar 2002 17:18:57 +0000 (+0100) Subject: a test for B::Xref X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8d9d21fc7f97563d8c8a7012e0c15c8f5aec8de;p=p5sagit%2Fp5-mst-13.2.git a test for B::Xref Message-ID: <20020313171857.F1144@rafael> p4raw-id: //depot/perl@15221 --- diff --git a/MANIFEST b/MANIFEST index 3649958..383a1db 100644 --- a/MANIFEST +++ b/MANIFEST @@ -106,6 +106,7 @@ ext/B/t/lint.t See if B::Lint works ext/B/t/showlex.t See if B::ShowLex works ext/B/t/stash.t See if B::Stash works ext/B/t/terse.t See if B::Terse works +ext/B/t/xref.t See if B::Xref works ext/B/TESTS Compiler backend test data ext/B/Todo Compiler backend Todo list ext/B/typemap Compiler backend interface types diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm index 5ae19be..f727dc7 100644 --- a/ext/B/B/Xref.pm +++ b/ext/B/B/Xref.pm @@ -1,6 +1,6 @@ package B::Xref; -our $VERSION = '1.00'; +our $VERSION = '1.01'; =head1 NAME @@ -21,8 +21,8 @@ The report generated is in the following format: File filename1 Subroutine subname1 Package package1 - object1 C - object2 C + object1 line numbers + object2 line numbers ... Package package2 ... @@ -64,6 +64,10 @@ Directs output to C 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. @@ -89,7 +93,7 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk. use strict; use Config; use B qw(peekop class comppadlist main_start svref_2object walksymtable - OPpLVAL_INTRO SVf_POK OPpOUR_INTRO + OPpLVAL_INTRO SVf_POK OPpOUR_INTRO cstring ); sub UNKNOWN { ["?", "?", "?"] } @@ -145,7 +149,7 @@ sub load_pad { 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); @@ -278,7 +282,8 @@ sub pp_const { # constant could be in the pad (under useithreads) if ($$sv) { $top = ["?", "", - (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"]; + (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) + ? cstring($sv->PV) : "?"]; } else { $top = $pad[$op->targ]; diff --git a/ext/B/t/xref.t b/ext/B/t/xref.t new file mode 100644 index 0000000..8268e3f --- /dev/null +++ b/ext/B/t/xref.t @@ -0,0 +1,102 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + @INC = qw(../lib); +} + +use strict; +use Test::More tests => 14; + +# line 50 +use_ok( 'B::Xref' ); + +my $file = 'xreftest.out'; + +# line 100 +our $compilesub = B::Xref::compile("-o$file"); +ok( ref $compilesub eq 'CODE', "compile() returns a coderef ($compilesub)" ); +$compilesub->(); # Compile this test script + +#END { unlink $file or diag "END block failed: $!" } + +# Now parse the output +# line 200 +my ($curfile, $cursub, $curpack) = ('') x 3; +our %xreftable = (); +open XREF, $file or die "# Can't open $file: $!\n"; +while () { + chomp; + if (/^File (.*)/) { + $curfile = $1; + } elsif (/^ Subroutine (.*)/) { + $cursub = $1; + } elsif (/^ Package (.*)/) { + $curpack = $1; + } elsif ($curpack eq '?' && /^ (".*") +(.*)/ + or /^ (\S+)\s+(.*)/) { + $xreftable{$curfile}{$cursub}{$curpack}{$1} = $2; + } +} +close XREF; +my $thisfile = __FILE__; + +ok( + defined $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'}, + '$compilesub present in main program' +); +like( + $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'}, + qr/\bi100\b/, + '$compilesub introduced at line 100' +); +like( + $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'}, + qr/&102\b/, + '$compilesub coderef called at line 102' +); +ok( + defined $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'}, + '$curfile present in main program' +); +like( + $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'}, + qr/\bi200\b/, + '$curfile introduced at line 200' +); +ok( + defined $xreftable{$thisfile}{'(main)'}{main}{'%xreftable'}, + '$xreftable present in main program' +); +ok( + defined $xreftable{$thisfile}{'Testing::Xref::foo'}{main}{'%xreftable'}, + '$xreftable used in subroutine bar' +); +is( + $xreftable{$thisfile}{'(main)'}{main}{'&use_ok'}, '&50', + 'use_ok called at line 50' +); +is( + $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&foo'}, 's1001', + 'subroutine foo defined at line 1001' +); +is( + $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&bar'}, 's1002', + 'subroutine bar defined at line 1002' +); +is( + $xreftable{$thisfile}{'Testing::Xref::bar'}{'Testing::Xref'}{'&foo'}, + '&1002', 'subroutine foo called at line 1002 by bar' +); +is( + $xreftable{$thisfile}{'Testing::Xref::foo'}{'Testing::Xref'}{'*FOO'}, + '1001', 'glob FOO used in subroutine foo' +); + +# End of tests. +# Now some stuff to feed B::Xref + +# line 1000 +package Testing::Xref; +sub foo { print FOO %::xreftable; } +sub bar { print FOO foo; }