ext/B/t/xref.t

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