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