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