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