The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

BEGIN { $| = 1; print "1..52\n"; }
END {print "not ok 1\n" unless $loaded;}
use String::Multibyte;
$^W = 1;
$loaded = 1;
print "ok 1\n";

$sjis  = String::Multibyte->new('ShiftJIS',1);
$euc   = String::Multibyte->new('EUC',1);
$utf8  = String::Multibyte->new('UTF8',1);

print $sjis->substr("\x81\x40\xAD\x40", 1) eq "\xAD\x40"
   && $euc ->substr("\xA1\xA1\x20\xBD\xBD",2) eq "\xBD\xBD"
   && $utf8->substr("\xC2\xA0\xEF\xBD\xBF\x60",1,1) eq "\xEF\xBD\xBF"
  ? "ok" : "not ok", " ", ++$loaded, "\n";

#####

sub asc2str ($$) {
   my($cs, $str) = @_;
   my $tmp =  {
      UTF16LE => 'v',   UTF32LE => 'V',
      UTF16BE => 'n',   UTF32BE => 'N',
   }->{$cs};
   $tmp and $str =~ s/([\x00-\xFF])/pack $tmp, ord $1/ge;
   return $str;
}
sub str2asc ($$) {
   my($cs, $str) = @_;
   my $re = {
      UTF16LE => '([\0-\xFF])\0',  UTF32LE => '([\0-\xFF])\0\0\0',
      UTF16BE => '\0([\0-\xFF])',  UTF32BE => '\0\0\0([\0-\xFF])',
   }->{$cs};
   $re and $str =~ s/$re/$1/g;
   return $str;
}
sub undefstr ($) {
   asc2str(shift, 'undef');
}

#####

@ran_char = (0xFF10, 0x2D, 0xFF19, 0xFF21, 0x2D, 0xFF3A, 0xFF41, 0x2D, 0xFF5A);
%ran = (
    Bytes => "0-9A-Za-z",
    EUC => "\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA",
    EUC_JP => "\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA",
    ShiftJIS => "\x82\x4F-\x82\x58\x82\x60-\x82\x79\x82\x81-\x82\x9A",
    UTF8 => pack('H*', "efbc902defbc99efbca12defbcbaefbd812defbd9a"),
    UTF16BE => pack('n*', @ran_char),
    UTF16LE => pack('v*', @ran_char),
    UTF32BE => pack('N*', @ran_char),
    UTF32LE => pack('V*', @ran_char),
    Unicode => $] < 5.008 ? "" : pack('U*', @ran_char),
);

@src_char = (0x30, 0xff11, 0xff12, 0xff13, 0x34, 0x35, 0x36, 0xff17);
%src = (
    Bytes => '01234567',
    EUC => pack('H*', '30a3b1a3b2a3b3343536a3b7'),
    EUC_JP => pack('H*', '30a3b1a3b2a3b3343536a3b7'),
    ShiftJIS => pack('H*', '308250825182523435368256'),
    UTF8 => pack('H*', '30efbc91efbc92efbc93343536efbc97'),
    UTF16BE => pack('n*', @src_char),
    UTF16LE => pack('v*', @src_char),
    UTF32BE => pack('N*', @src_char),
    UTF32LE => pack('V*', @src_char),
    Unicode => $] < 5.008 ? ""  : pack('U*', @src_char),
);

%rep = (
    Bytes => 'RE',
    EUC => "\xa3\xd2\xa3\xc5",
    EUC_JP => "\xa3\xd2\xa3\xc5",
    ShiftJIS => "\x82\x71\x82\x64",
    UTF8 => "\xef\xbc\xb2\xef\xbc\xa5",
    UTF16BE => pack('n*', 0xff32, 0xff25),
    UTF16LE => pack('v*', 0xff32, 0xff25),
    UTF32BE => pack('N*', 0xff32, 0xff25),
    UTF32LE => pack('V*', 0xff32, 0xff25),
    Unicode => $] < 5.008 ? ""  : pack('U*', 0xff32, 0xff25),
);

#####

for $cs (qw/Bytes EUC EUC_JP ShiftJIS
	UTF8 UTF16BE UTF16LE UTF32BE UTF32LE Unicode/) {
    if ($cs eq 'Unicode' && $] < 5.008) {
	for (1..5) { print("ok ", ++$loaded, "\n"); }
	next;
    }
    $mb = String::Multibyte->new($cs,1);

    $alnumZ2H = $mb->trclosure($ran{$cs}, asc2str($cs, $ran{Bytes}));

    $str = $src{Bytes};
    $zen = $src{$cs};

    $NG = 0;
    for $i (-10..10) {
	next if 5.004 > $] && $i < -8;
	local $^W = 0;
	$s = substr($str,$i);
	$t = $mb->substr($zen,$i);
	$s = "undef" if ! defined $s;
	$t = undefstr($cs) if ! defined $t;
	++$NG unless $s eq str2asc($cs, &$alnumZ2H($t));
    }
    print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    $NG = 0;
    for $i (-10..10) {
	next if 5.004 > $] && $i < -8;
	for $j (undef, -10..10) {
	    local $^W = 0;
	    $s = substr($str,$i,$j);
	    $t = $mb->substr($zen,$i,$j);
	    $s = "undef" if ! defined $s;
	    $t = undefstr($cs) if ! defined $t;
	    ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t));
	}
    }
    print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    $NG = 0;
    for $i (-8..8) {
	local $^W = 0;
	$s = $str;
	$t = $zen;
	substr($s,$i) = $rep{Bytes};
	${ $mb->substr(\$t,$i) } = $rep{$cs};
	++$NG unless $s eq str2asc($cs, &$alnumZ2H($t));
    }
    print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    $NG = 0;
    for $i (-8..8) {
	for $j (undef,-10..10) {
	    local $^W = 0;
	    $s = $str;
	    $t = $zen;
	    substr($s,$i,$j) = $rep{Bytes};
	    ${ $mb->substr(\$t,$i,$j) } = $rep{$cs};
	    ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t));
	}
    }
    print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    $NG = 0;
    for $i (-8..8) {
	last if 5.005 > $];
	for $j (-10..10) {
	    local $^W = 0;
	    $s = $str;
	    $t = $zen;
	    $core = ''; # avoid "used only once"
	    eval q{ $core = substr($s,$i,$j, $rep{Bytes}) };
	    $mbcs = $mb->substr($t,$i,$j,$rep{$cs});
	    ++$NG unless $s eq str2asc($cs, &$alnumZ2H($t));
	    ++$NG unless $core eq str2asc($cs, &$alnumZ2H($mbcs));
	}
    }
    print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n";
}

1;
__END__