ext/B/t/xref.t

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