xref: /openbsd/gnu/usr.bin/perl/ext/B/t/xref.t (revision 73471bf0) 
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" );
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    print STDERR $_ if $ENV{PERL_DEBUG};
38    chomp;
39    if (/^File (.*)/) {
40	$curfile = $1;
41    } elsif (/^  Subroutine (.*)/) {
42	$cursub = $1;
43    } elsif (/^    Package (.*)/) {
44	$curpack = $1;
45    } elsif ($curpack eq '?' && /^      (".*")  +(.*)/
46	    or /^      (\S+)\s+(.*)/) {
47	$xreftable{$curfile}{$cursub}{$curpack}{$1} = $2;
48    }
49}
50close XREF;
51my $thisfile = __FILE__;
52
53ok(
54    defined $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'},
55    '$compilesub present in main program'
56);
57like(
58    $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'},
59    qr/\bi100\b/,
60    '$compilesub introduced at line 100'
61);
62like(
63    $xreftable{$thisfile}{'(main)'}{main}{'$compilesub'},
64    qr/&102\b/,
65    '$compilesub coderef called at line 102'
66);
67ok(
68    defined $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'},
69    '$curfile present in main program'
70);
71like(
72    $xreftable{$thisfile}{'(main)'}{'(lexical)'}{'$curfile'},
73    qr/\bi200\b/,
74    '$curfile introduced at line 200'
75);
76ok(
77    defined $xreftable{$thisfile}{'(main)'}{main}{'%xreftable'},
78    '$xreftable present in main program'
79);
80ok(
81    defined $xreftable{$thisfile}{'Testing::Xref::foo'}{main}{'%xreftable'},
82    '$xreftable used in subroutine bar'
83);
84is(
85    $xreftable{$thisfile}{'(main)'}{main}{'&use_ok'}, '&50',
86    'use_ok called at line 50'
87);
88is(
89    $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&foo'}, 's1001',
90    'subroutine foo defined at line 1001'
91);
92is(
93    $xreftable{$thisfile}{'(definitions)'}{'Testing::Xref'}{'&bar'}, 's1002',
94    'subroutine bar defined at line 1002'
95);
96is(
97    $xreftable{$thisfile}{'Testing::Xref::bar'}{'Testing::Xref'}{'&foo'},
98    '&1002', 'subroutine foo called at line 1002 by bar'
99);
100is(
101    $xreftable{$thisfile}{'Testing::Xref::foo'}{'Testing::Xref'}{'*FOO'},
102    '1001', 'glob FOO used in subroutine foo'
103);
104
105END {
106    1 while unlink $file;
107}
108
109# End of tests.
110# Now some stuff to feed B::Xref
111
112# line 1000
113package Testing::Xref;
114sub foo { print FOO %::xreftable; }
115sub bar { print FOO foo; }
116
117