Change 15221 by jhi@alpha on 2002/03/14 13:51:17
Subject: [PATCH] a test for B::Xref
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
Date: Wed, 13 Mar 2002 17:18:57 +0100
Message-ID: <20020313171857.F1144@rafael>
Affected files ...
.... //depot/perl/MANIFEST#769 edit
.... //depot/perl/ext/B/B/Xref.pm#14 edit
.... //depot/perl/ext/B/t/xref.t#1 add
Differences ...
==== //depot/perl/MANIFEST#769 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Thu Mar 14 07:00:05 2002
+++ perl/MANIFEST Thu Mar 14 07:00:05 2002
@@ -106,6 +106,7 @@
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
==== //depot/perl/ext/B/B/Xref.pm#14 (text) ====
Index: perl/ext/B/B/Xref.pm
--- perl/ext/B/B/Xref.pm.~1~ Thu Mar 14 07:00:05 2002
+++ perl/ext/B/B/Xref.pm Thu Mar 14 07:00:05 2002
@@ -1,6 +1,6 @@
package B::Xref;
-our $VERSION = '1.00';
+our $VERSION = '1.01';
=head1 NAME
@@ -21,8 +21,8 @@
File filename1
Subroutine subname1
Package package1
- object1 C<line numbers>
- object2 C<line numbers>
+ object1 line numbers
+ object2 line numbers
...
Package package2
...
@@ -64,6 +64,10 @@
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 @@
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 @@
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 @@
# 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];
==== //depot/perl/ext/B/t/xref.t#1 (text) ====
Index: perl/ext/B/t/xref.t
--- perl/ext/B/t/xref.t.~1~ Thu Mar 14 07:00:05 2002
+++ perl/ext/B/t/xref.t Thu Mar 14 07:00:05 2002
@@ -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 (<XREF>) {
+ 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; }
End of Patch.
