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