ext/B/t/invlist.t

   1 #!./perl
   2
   3 BEGIN {
   4     unshift @INC, 't';
   5     require Config;
   6     if ( ( $Config::Config{'extensions'} !~ /\bB\b/ ) ) {
   7         print "1..0 # Skip -- Perl configured without B module\n";
   8         exit 0;
   9     }
  10 }
  11
  12 use strict;
  13 use warnings;
  14 use Test::More;
  15
  16 if ( $Config::Config{useithreads} ) {
  17     plan( skip_all => "Perl compiled with ithreads... no invlist in the example");
  18 }
  19
  20 use_ok('B');
  21
  22 # Somewhat minimal tests.
  23
  24 my $found_invlist;
  25
  26 # we are going to walk this sub
  27 sub check {
  28     "ABCD" !~ tr/\0-\377//c;    # this is using the Latin1_invlist
  29 }
  30
  31 sub B::OP::visit {
  32     my $op = shift;
  33
  34     note ref($op) . " ; NAME: ", $op->name, " ; TYPE: ", $op->type;
  35
  36     return unless ref $op eq 'B::SVOP' && $op->name eq 'trans';
  37
  38     my $sv = $op->sv;
  39
  40     note "SV: ", ref $sv, " = " . $sv->LEN . " " . $sv->CUR;
  41     foreach my $elt ( $sv->ARRAY ) {
  42         next unless ref $elt eq 'B::INVLIST';
  43         $found_invlist = 1;
  44         my $invlist = $elt;
  45
  46         is $invlist->prev_index, 0, "prev_index=0";
  47         is $invlist->is_offset,  0, "is_offset = 0 (false)";
  48
  49         my @array = $invlist->get_invlist_array;
  50         is scalar @array, 2, "invlist array size is 2" or diag explain \@array;
  51         is $array[0], 0,   "PL_Latin1 first value in the invlist array is 0"  or diag explain \@array;
  52         is $array[1], 256, "PL_Latin1 second value in the invlist array is 0" or diag explain \@array;
  53
  54         is $invlist->array_len(), 2, "PL_Latin1 array length is 2";
  55     }
  56
  57     return;
  58 }
  59
  60 my $op = B::svref_2object( \*main::check );
  61 B::walkoptree( $op->CV->ROOT, 'visit' );
  62
  63 ok $found_invlist, "visited one INVLIST";
  64
  65 done_testing();