ext/B/t/asmdata.t

   1 #!./perl -Tw
   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 Test::More tests => 13;
  18
  19 use_ok('B::Asmdata', qw(%insn_data @insn_name @optype @specialsv_name));
  20
  21 # check we got something.
  22 isnt( keys %insn_data,  0,  '%insn_data exported and populated' );
  23 isnt( @insn_name,       0,  '   @insn_name' );
  24 isnt( @optype,          0,  '   @optype' );
  25 isnt( @specialsv_name,  0,  '   @specialsv_name' );
  26
  27 # pick an op that's not likely to go away in the future
  28 my @data = values %insn_data;
  29 is( (grep { ref eq 'ARRAY' } @data),  @data,   '%insn_data contains arrays' );
  30
  31 # pick one at random to test with.
  32 my $opname = (keys %insn_data)[rand @data];
  33 my $data = $insn_data{$opname};
  34 like( $data->[0], qr/^\d+$/,    '   op number' );
  35 is( ref $data->[1],  'CODE',    '   PUT code ref' );
  36 ok( !ref $data->[2],            '   GET method' );
  37
  38 is( $insn_name[$data->[0]], $opname,    '@insn_name maps correctly' );
  39
  40
  41 # I'm going to assume that op types will all be named /OP$/.
  42 # If this changes in the future, change this test.
  43 is( grep(/OP$/, @optype), @optype,  '@optype is all /OP$/' );
  44
  45
  46 # comment in bytecode.pl says "Nullsv *must come first so that the
  47 # condition ($$sv == 0) can continue to be used to test (sv == Nullsv)."
  48 is( $specialsv_name[0],  'Nullsv',  'Nullsv come first in @special_sv_name' );
  49
  50 # other than that, we can't really say much more about @specialsv_name
  51 # than it has to contain strings (on the off chance &PL_sv_undef gets
  52 # flubbed)
  53 is( grep(!ref, @specialsv_name), @specialsv_name,   '  contains all strings' );