Commit | Line | Data |
f8d9d21f |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = qw(../lib); |
6 | } |
7 | |
8 | use strict; |
9 | use Test::More tests => 14; |
10 | |
11 | # line 50 |
12 | use_ok( 'B::Xref' ); |
13 | |
14 | my $file = 'xreftest.out'; |
15 | |
16 | # line 100 |
17 | our $compilesub = B::Xref::compile("-o$file"); |
18 | ok( ref $compilesub eq 'CODE', "compile() returns a coderef ($compilesub)" ); |
19 | $compilesub->(); # Compile this test script |
20 | |
21 | #END { unlink $file or diag "END block failed: $!" } |
22 | |
23 | # Now parse the output |
24 | # line 200 |
25 | my ($curfile, $cursub, $curpack) = ('') x 3; |
26 | our %xreftable = (); |
27 | open XREF, $file or die "# Can't open $file: $!\n"; |
28 | while (<XREF>) { |
29 | chomp; |
30 | if (/^File (.*)/) { |
31 | $curfile = $1; |
32 | } elsif (/^ Subroutine (.*)/) { |
33 | $cursub = $1; |
34 | } elsif (/^ Package (.*)/) { |
35 | $curpack = $1; |
36 | } elsif ($curpack eq '?' && /^ (".*") +(.*)/ |
37 | or /^ (\S+)\s+(.*)/) { |
38 | $xreftable{$curfile}{$cursub}{$curpack}{$1} = $2; |
39 | } |
40 | } |
41 | close XREF; |
42 | my $thisfile = __FILE__; |
43 | |
44 | ok( |
45 | defined $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'}, |
46 | '$compilesub present in main program' |
47 | ); |
48 | like( |
49 | $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'}, |
50 | qr/\bi100\b/, |
51 | '$compilesub introduced at line 100' |
52 | ); |
53 | like( |
54 | $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'}, |
55 | qr/&102\b/, |
56 | '$compilesub coderef called at line 102' |
57 | ); |
58 | ok( |
59 | defined $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'}, |
60 | '$curfile present in main program' |
61 | ); |
62 | like( |
63 | $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'}, |
64 | qr/\bi200\b/, |
65 | '$curfile introduced at line 200' |
66 | ); |
67 | ok( |
68 | defined $xreftable{$thisfile}{'(main)'}{main}{'%xreftable'}, |
69 | '$xreftable present in main program' |
70 | ); |
71 | ok( |
72 | defined $xreftable{$thisfile}{'Testing::Xref::foo'}{main}{'%xreftable'}, |
73 | '$xreftable used in subroutine bar' |
74 | ); |
75 | is( |
76 | $xreftable{$thisfile}{'(main)'}{main}{'&use_ok'}, '&50', |
77 | 'use_ok called at line 50' |
78 | ); |
79 | is( |
80 | $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&foo'}, 's1001', |
81 | 'subroutine foo defined at line 1001' |
82 | ); |
83 | is( |
84 | $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&bar'}, 's1002', |
85 | 'subroutine bar defined at line 1002' |
86 | ); |
87 | is( |
88 | $xreftable{$thisfile}{'Testing::Xref::bar'}{'Testing::Xref'}{'&foo'}, |
89 | '&1002', 'subroutine foo called at line 1002 by bar' |
90 | ); |
91 | is( |
92 | $xreftable{$thisfile}{'Testing::Xref::foo'}{'Testing::Xref'}{'*FOO'}, |
93 | '1001', 'glob FOO used in subroutine foo' |
94 | ); |
95 | |
96 | # End of tests. |
97 | # Now some stuff to feed B::Xref |
98 | |
99 | # line 1000 |
100 | package Testing::Xref; |
101 | sub foo { print FOO %::xreftable; } |
102 | sub bar { print FOO foo; } |