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