ext/B/t/xref.t

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