1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
#!./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 {
close XREF;
1 while unlink $file;
}
# 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; }
|
