1#!./perl 2 3BEGIN { 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 12use strict; 13use warnings; 14use Test::More; 15 16if ( $Config::Config{useithreads} ) { 17 plan( skip_all => "Perl compiled with ithreads... no invlist in the example"); 18} 19 20use_ok('B'); 21 22# Somewhat minimal tests. 23 24my $found_invlist; 25 26# we are going to walk this sub 27sub check { 28 "ABCD" !~ tr/\0-\377//c; # this is using the Latin1_invlist 29} 30 31sub 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 60my $op = B::svref_2object( \*main::check ); 61B::walkoptree( $op->CV->ROOT, 'visit' ); 62 63ok $found_invlist, "visited one INVLIST"; 64 65done_testing(); 66