ext/B/t/xref.t

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