asmdata.t 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101
  1. #!/usr/bin/env perl -w
  2. # blead cannot run -T
  3. BEGIN {
  4. if ($ENV{PERL_CORE}) {
  5. push @INC, ('../../lib');
  6. }
  7. require Config;
  8. if ($ENV{PERL_CORE} and ($Config::Config{'extensions'} !~ /\bB\b/) ){
  9. print "1..0 # Skip -- Perl configured without B module\n";
  10. exit 0;
  11. }
  12. }
  13. use Test::More;
  14. if (!-d '.git' or $ENV{NO_AUTHOR}) {
  15. plan tests => ($] < 5.009) ? 15 : 16;
  16. }
  17. use B ();
  18. if ($] < 5.009) {
  19. use_ok('B::Asmdata', qw(%insn_data @insn_name @optype @specialsv_name));
  20. } else {
  21. use_ok('B', qw(@optype @specialsv_name));
  22. use_ok('B::Asmdata', qw(%insn_data @insn_name));
  23. }
  24. # see bytecode.pl (alias_to or argtype) and ByteLoader/bytecode.h
  25. my @valid_type = qw(comment_t none svindex pvindex opindex U32 U16 U8 I32 IV long NV
  26. PADOFFSET pvcontents strconst op_tr_array pmflags PV IV64);
  27. my %valid_type = map {$_ => 1} @valid_type;
  28. # check we got something.
  29. isnt( keys %insn_data, 0, '%insn_data exported and populated' );
  30. isnt( @insn_name, 0, ' @insn_name' );
  31. isnt( @optype, 0, ' @optype' );
  32. isnt( @specialsv_name, 0, ' @specialsv_name' );
  33. # pick an op that's not likely to go away in the future
  34. my @data = values %insn_data;
  35. is( (grep { ref eq 'ARRAY' } @data), @data, '%insn_data contains arrays' );
  36. # sort out unsupport ones, with no PUT method
  37. # @data = grep {$_[1]} @data;
  38. # pick one at random to test with.
  39. my (@opnames, $random);
  40. unless (!-d '.git' or $ENV{NO_AUTHOR}) {
  41. @opnames = sort keys %insn_data;
  42. $random = "";
  43. } else {
  44. @opnames = ( (keys %insn_data)[rand @data] );
  45. $random = "random";
  46. }
  47. for my $opname (@opnames) {
  48. my $data = $insn_data{$opname};
  49. my $opidx = $data->[0];
  50. like( $data->[0], qr/^\d+$/, " op number for $random $opname:$opidx" );
  51. if ($data->[1]) {
  52. is( ref $data->[1], 'CODE', " PUT code ref for $opname" );
  53. my $putname = B::svref_2object($data->[1])->GV->NAME;
  54. $putname =~ s/^PUT_//;
  55. ok( $valid_type{$putname}, " valid PUT name $putname for $opname" );
  56. } else {
  57. ok(1, " empty PUT for $opname" );
  58. ok(1, " skip valid PUT name check" );
  59. }
  60. ok( !ref $data->[2], " GET method for $opname" );
  61. my $getname = $data->[2];
  62. my $ok;
  63. if ($getname =~ /^GET_(.*)$/) {
  64. $ok = $valid_type{$1};
  65. }
  66. ok( $ok, " GET method $getname looks good" );
  67. is( $insn_name[$data->[0]], $opname, '@insn_name maps correctly' );
  68. }
  69. # I'm going to assume that op types will all be named /OP$/.
  70. # Just 5.22 added a UNOP_AUX
  71. if ($] >= 5.021007) {
  72. is( grep(/OP$/, @optype), scalar(@optype) - 1, '@optype is almost all /OP$/' );
  73. } else {
  74. is( grep(/OP$/, @optype), @optype, '@optype is all /OP$/' );
  75. }
  76. # comment in bytecode.pl says "Nullsv *must come first so that the
  77. # condition ($$sv == 0) can continue to be used to test (sv == Nullsv)."
  78. is( $specialsv_name[0], 'Nullsv', 'Nullsv come first in @special_sv_name' );
  79. # other than that, we can't really say much more about @specialsv_name
  80. # than it has to contain strings (on the off chance &PL_sv_undef gets
  81. # flubbed)
  82. is( grep(!ref, @specialsv_name), @specialsv_name, ' contains all strings' );
  83. unless (!-d '.git' or $ENV{NO_AUTHOR}) {
  84. done_testing;
  85. }