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

%Template = (
    UTF16LE => 'v*',   UTF16BE => 'n*',
    UTF32LE => 'V*',   UTF32BE => 'N*',
);
sub asc2str ($$) {
   my($cs, $str) = @_;
   return $str if ! $Template{$cs};
   return pack($Template{$cs}, unpack 'C*', $str);
}
sub str2asc ($$) {
   my($cs, $str) = @_;
   return $str if ! $Template{$cs};
   return pack('C*', unpack $Template{$cs}, $str);
}
sub list2str {
    my $cs = shift;
    my $lt = asc2str($cs, '<');
    my $gt = asc2str($cs, '>');
    return @_ ? join('', map "$lt$_$gt", @_) : '';
}

#####

@ran_char = (0xFF21,0x2D,0xFF3A,0xFF41,0x2D,0xFF5A,0x3000,0xFF20,0xFF1D);
%ran = (
    Bytes =>   "A-Za-z\x20\x40=",
    EUC =>      "\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA\xA1\xA1\xA1\xF7\xA1\xE1",
    EUC_JP =>   "\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA\xA1\xA1\xA1\xF7\xA1\xE1",
    ShiftJIS => "\x82\x60-\x82\x79\x82\x81-\x82\x9A\x81\x40\x81\x97\x81\x81",
    UTF8    => pack('H*', "efbca12defbcbaefbd812defbd9ae38080efbca0efbc9d"),
    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 = (0x3000, 0x3000, 0x54, 0xff48, 0x69, 0xff53, 0x3000,
   0x3000, 0x69, 0x73, 0x3000, 0x3000, 0x3000, 0x61, 0x3000, 0x3000,
   0xff34, 0xff25, 0x53, 0x54, 0x3000, 0xff1d, 0x40, 0x3000);
%src = (
    Bytes => '  This  is   a  TEST =@ ',
    EUC =>      pack('H*', 'a1a1a1a154a3e869a3f3a1a1a1a16973a1a1a1a1a1a161a1a1a1a1a3d4a3c55354a1a1a1e140a1a1'),
    EUC_JP =>      pack('H*', 'a1a1a1a154a3e869a3f3a1a1a1a16973a1a1a1a1a1a161a1a1a1a1a3d4a3c55354a1a1a1e140a1a1'),
    ShiftJIS => pack('H*', '81408140548288698293814081406973814081408140618140814082738264535481408181408140'),
    UTF8    =>  pack('H*', 'e38080e3808054efbd8869efbd93e38080e380806973e38080e38080e3808061e38080e38080efbcb4efbca55354e38080efbc9d40e38080'),
    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),
);

%space = (
    Bytes => ' ',
    EUC =>      "\xa1\xa1",
    EUC_JP =>   "\xa1\xa1",
    ShiftJIS => "\x81\x40",
    UTF8 =>     "\xe3\x80\x80",
    UTF16BE =>  "\x30\x00",
    UTF16LE =>  "\x00\x30",
    UTF32BE =>  "\x00\x00\x30\x00",
    UTF32LE =>  "\x00\x30\x00\x00",
    Unicode => $] < 5.008 ? "" : pack('U*', 0x3000),
);

#####

for $cset (qw/Bytes EUC EUC_JP ShiftJIS
	UTF8 UTF16BE UTF16LE UTF32BE UTF32LE Unicode/) {
    if ($cset eq 'Unicode' && $] < 5.008) {
	for (1..7) { print("ok ", ++$loaded, "\n"); }
	next;
    }
    if ($] < 5.005 && ($cset eq 'UTF32BE' || $cset eq 'UTF32LE')) {
	for (1..7) { print("ok ", ++$loaded, "\n"); }
	next;
    }
    testsplit($cset);
}

sub testsplit {
    my $cs  = shift;
    my $mb  = String::Multibyte->new($cs,1);
    my $tr  = $mb->trclosure($ran{$cs}, asc2str($cs, $ran{Bytes}));
    my $str = $src{Bytes};
    my $zen = $src{$cs};
    my $sp  = $space{$cs};

    # splitchar in scalar context
    $NG = 0;
    for ($n = -1; $n <= 20; $n++) {
	my $core = @{[ split(//, $str, $n) ]};
	my $mbcs = $mb->strsplit('',$zen,$n);
	++$NG unless $core == $mbcs;
    }
    print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    # splitchar in list context
    $NG = 0;
    for ($n = -1; $n <= 20; $n++) {
	my $core = list2str('CORE', split //, $str, $n );
	my $mbcs = list2str($cs, $mb->strsplit('', $zen, $n) );
	++$NG unless $core eq str2asc($cs, &$tr($mbcs));
    }
    print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    # split / / in list context
    $NG = 0;
    for ($n = -1; $n <= 5; $n++) {
	my $core = @{[ split(/ /, $str, $n) ]};
	my $mbcs = $mb->strsplit($sp, $zen, $n);
	++$NG unless $core == $mbcs;
    }
    print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    # split / / in list context
    $NG = 0;
    for ($n = -1; $n <= 5; $n++) {
	my $core = list2str('CORE', split(/ /, $str, $n));
	my $mbcs = list2str($cs,  $mb->strsplit($sp, $zen, $n) );
	++$NG unless $core eq str2asc($cs, &$tr($mbcs));
    }
    print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    # splitchar of null string in scalar context
    $NG = 0;
    for ($n = -1; $n <= 20; $n++) {
	my $core = @{[ split(//, '', $n) ]};
	my $mbcs = $mb->strsplit('','',$n);
	++$NG unless $core == $mbcs;
    }
    print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n";

   # splitchar of null string in list context
    $NG = 0;
    for ($n = -1; $n <= 20; $n++) {
	my $core = list2str('CORE', split //, '', $n);
	my $mbcs = list2str($cs, $mb->strsplit('','',$n));
	++$NG unless $core eq str2asc($cs, $mbcs);
    }
    print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    # split / /, '' in list context
    $NG = 0;
    for ($n = -1; $n <= 5; $n++) {
	my $core = list2str('CORE', split(/ /, '', $n) );
	my $mbcs = list2str($cs, $mb->strsplit($sp, '', $n) );
	++$NG unless $core eq str2asc($cs, $mbcs);
    }
    print !$NG ? "ok" : "not ok", " ", ++$loaded, "\n";
}

1;
__END__