1*de8cc8edSafresh1#!./perl 2*de8cc8edSafresh1 3*de8cc8edSafresh1BEGIN { 4*de8cc8edSafresh1 unshift @INC, 't'; 5*de8cc8edSafresh1 require Config; 6*de8cc8edSafresh1 if (($Config::Config{'extensions'} !~ /\bB\b/) ){ 7*de8cc8edSafresh1 print "1..0 # Skip -- Perl configured without B module\n"; 8*de8cc8edSafresh1 exit 0; 9*de8cc8edSafresh1 } 10*de8cc8edSafresh1} 11*de8cc8edSafresh1 12*de8cc8edSafresh1$| = 1; 13*de8cc8edSafresh1use warnings; 14*de8cc8edSafresh1use strict; 15*de8cc8edSafresh1BEGIN { 16*de8cc8edSafresh1 eval { require threads; threads->import; } 17*de8cc8edSafresh1} 18*de8cc8edSafresh1use Test::More; 19*de8cc8edSafresh1 20*de8cc8edSafresh1BEGIN { use_ok( 'B' ); } 21*de8cc8edSafresh1 22*de8cc8edSafresh1for my $do_utf8 (""," utf8") { 23*de8cc8edSafresh1 my $max = $do_utf8 ? 1024 : 255; 24*de8cc8edSafresh1 my @bad; 25*de8cc8edSafresh1 for my $cp ( 0 .. $max ) { 26*de8cc8edSafresh1 my $char= chr($cp); 27*de8cc8edSafresh1 utf8::upgrade($char); 28*de8cc8edSafresh1 my $escaped= B::perlstring($char); 29*de8cc8edSafresh1 my $evalled= eval $escaped; 30*de8cc8edSafresh1 push @bad, [ $cp, $evalled, $char, $escaped ] if $evalled ne $char; 31*de8cc8edSafresh1 } 32*de8cc8edSafresh1 is(0+@bad, 0, "Check if any$do_utf8 codepoints fail to round trip through B::perlstring()"); 33*de8cc8edSafresh1 if (@bad) { 34*de8cc8edSafresh1 foreach my $tuple (@bad) { 35*de8cc8edSafresh1 my ( $cp, $evalled, $char, $escaped ) = @$tuple; 36*de8cc8edSafresh1 is($evalled, $char, "check if B::perlstring of$do_utf8 codepoint $cp round trips ($escaped)"); 37*de8cc8edSafresh1 } 38*de8cc8edSafresh1 } 39*de8cc8edSafresh1} 40*de8cc8edSafresh1 41*de8cc8edSafresh1done_testing(); 42