6 @INC = ('.', '../lib');
11 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
12 print "1..0 # Skip -- Perl configured without B module\n";
20 use Test::More tests => 14;
25 my $file = 'xreftest.out';
27 open SAVEOUT, ">&STDOUT" or diag $!;
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
34 open STDOUT, ">&SAVEOUT" or diag $!;
36 # Now parse the output
38 my ($curfile, $cursub, $curpack) = ('') x 3;
40 open XREF, $file or die "# Can't open $file: $!\n";
45 } elsif (/^ Subroutine (.*)/) {
47 } elsif (/^ Package (.*)/) {
49 } elsif ($curpack eq '?' && /^ (".*") +(.*)/
50 or /^ (\S+)\s+(.*)/) {
51 $xreftable{$curfile}{$cursub}{$curpack}{$1} = $2;
55 my $thisfile = __FILE__;
58 defined $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'},
59 '$compilesub present in main program'
62 $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'},
64 '$compilesub introduced at line 100'
67 $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'},
69 '$compilesub coderef called at line 102'
72 defined $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'},
73 '$curfile present in main program'
76 $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'},
78 '$curfile introduced at line 200'
81 defined $xreftable{$thisfile}{'(main)'}{main}{'%xreftable'},
82 '$xreftable present in main program'
85 defined $xreftable{$thisfile}{'Testing::Xref::foo'}{main}{'%xreftable'},
86 '$xreftable used in subroutine bar'
89 $xreftable{$thisfile}{'(main)'}{main}{'&use_ok'}, '&50',
90 'use_ok called at line 50'
93 $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&foo'}, 's1001',
94 'subroutine foo defined at line 1001'
97 $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&bar'}, 's1002',
98 'subroutine bar defined at line 1002'
101 $xreftable{$thisfile}{'Testing::Xref::bar'}{'Testing::Xref'}{'&foo'},
102 '&1002', 'subroutine foo called at line 1002 by bar'
105 $xreftable{$thisfile}{'Testing::Xref::foo'}{'Testing::Xref'}{'*FOO'},
106 '1001', 'glob FOO used in subroutine foo'
110 1 while unlink $file;
114 # Now some stuff to feed B::Xref
117 package Testing::Xref;
118 sub foo { print FOO %::xreftable; }
119 sub bar { print FOO foo; }