ext/B/t/xref.t

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