xref: /openbsd-src/gnu/usr.bin/perl/ext/B/t/xref.t (revision 898184e3e61f9129feb5978fad5a8c6865f00b92)
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