# This file is encoded in Shift_JIS.
die "This file is not encoded in Shift_JIS.\n" if '偁' ne "\x82\xA0";
die "This script is for perl only. You are using $^X.\n" if $^X =~ /jperl/i;

use strict;
use FindBin;
use lib "$FindBin::Bin/../lib";
use mb;
mb::set_script_encoding('sjis');
use vars qw(@test);

BEGIN {
    $SIG{__WARN__} = sub {
        local($_) = @_;
        /\AUse of uninitialized value \$_\[[0123456789]+\] in join or string at / ? return :
        warn $_[0];
    };
}

@test = (

# 1 returning the resulting list value in list context
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠'); "@_" eq "俙 俛 俠" },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 11 or the count of substrings in scalar context
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠'); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 21 if the PATTERN doesn't match the string at all, split returns the original string as a single substring
    sub { @_=mb::_split(qr/俀/,'俙侾俛侾俠'); "@_" eq "俙侾俛侾俠" },
    sub { $_=mb::_split(qr/俀/,'俙侾俛侾俠'); $_ == 1 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 31 if it matches once, you get two substrings,
    sub { @_=mb::_split(qr/侾/,'俙侾俛'); "@_" eq "俙 俛" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛'); $_ == 2 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 41 and so on
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠'); "@_" eq "俙 俛 俠" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠'); $_ == 3 },
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠侾俢'); "@_" eq "俙 俛 俠 俢" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠侾俢'); $_ == 4 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 51 you may supply regular expression modifiers to the PATTERN, like /PATTERN/i,
    sub { @_=mb::_split(qr/a/,'侾a俀a俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/a/,'侾a俀a俁');  $_ == 3 },
    sub { @_=mb::_split(qr/a/i,'侾a俀a俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/a/i,'侾a俀a俁');  $_ == 3 },
    sub { @_=mb::_split(qr/A/i,'侾a俀a俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/A/i,'侾a俀a俁');  $_ == 3 },
    sub { @_=mb::_split(qr/a/i,'侾A俀A俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/a/i,'侾A俀A俁');  $_ == 3 },
    sub { @_=mb::_split(qr/A/i,'侾A俀A俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/A/i,'侾A俀A俁');  $_ == 3 },

# 61 /PATTERN/x,
    sub { @_=mb::_split(qr/ a /x,'侾a俀a俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/ a /x,'侾a俀a俁');  $_ == 3 },
    sub { @_=mb::_split(qr/ a /ix,'侾a俀a俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/ a /ix,'侾a俀a俁');  $_ == 3 },
    sub { @_=mb::_split(qr/ A /ix,'侾a俀a俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/ A /ix,'侾a俀a俁');  $_ == 3 },
    sub { @_=mb::_split(qr/ a /ix,'侾A俀A俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/ a /ix,'侾A俀A俁');  $_ == 3 },
    sub { @_=mb::_split(qr/ A /ix,'侾A俀A俁'); "@_" eq "侾 俀 俁" },
    sub { $_=mb::_split(qr/ A /ix,'侾A俀A俁');  $_ == 3 },

# 71 the //m modifier is assumed when you split on the pattern /^/
    sub { return 'SKIP'; @_=mb::_split(qr/^/,"俙\n俛\n俠"); "@_" eq "俙\n 俛\n 俠" },
    sub { return 'SKIP'; $_=mb::_split(qr/^/,"俙\n俛\n俠");  $_ == 3 },
    sub { @_=mb::_split(qr/^/m,"俙\n俛\n俠"); "@_" eq "俙\n 俛\n 俠" },
    sub { $_=mb::_split(qr/^/m,"俙\n俛\n俠");  $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 81 if LIMIT is specified and positive, the function splits into no more than that many fields
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠',2); "@_" eq "俙 俛侾俠" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠',2); $_ == 2 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 91 (though it may split into fewer if it runs out of separators)
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠',4); "@_" eq "俙 俛 俠" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠',4); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 101 if LIMIT is negative, it is treated as if an arbitrarily large LIMIT has been specified
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠',-1); "@_" eq "俙 俛 俠" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠',-1); $_ == 3 },
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠侾',4); "@_" eq "俙 俛 俠 " },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠侾',4); $_ == 4 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 111 if LIMIT is omitted
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠侾',); "@_" eq "俙 俛 俠" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠侾',); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 121 or zero, trailing null fields are stripped from the result
    sub { @_=mb::_split(qr/侾/,'俙侾俛侾俠侾',0); "@_" eq "俙 俛 俠" },
    sub { $_=mb::_split(qr/侾/,'俙侾俛侾俠侾',0); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 131 if EXPR is omitted, the function splits the $_ string
    sub { $_='俙侾俛侾俠'; @_=mb::_split(qr/侾/); "@_" eq "俙 俛 俠" },
    sub { $_='俙侾俛侾俠'; $_=mb::_split(qr/侾/); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 141 if PATTERN is also omitted
    sub { $_='俙 俛 俠'; @_=mb::_split(); "@_" eq "俙 俛 俠" },
    sub { $_='俙 俛 俠'; $_=mb::_split(); $_ == 3 },
    sub { $_='俙 俛 俠'; @_=mb::_split; "@_" eq "俙 俛 俠" },
    sub { $_='俙 俛 俠'; $_=mb::_split; $_ == 3 },
    sub { $_=' 俙 俛 俠'; @_=mb::_split; "@_" eq "俙 俛 俠" },
    sub { $_=' 俙 俛 俠'; $_=mb::_split; $_ == 3 },
    sub { $_='俙  俛  俠'; @_=mb::_split; "@_" eq "俙 俛 俠" },
    sub {1},
    sub {1},
    sub {1},
# 151
    sub { $_='俙  俛  俠'; $_=mb::_split; $_ == 3 },
    sub { $_=' 俙  俛  俠'; @_=mb::_split; "@_" eq "俙 俛 俠" },
    sub { $_=' 俙  俛  俠'; $_=mb::_split; $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 161 or is the literal space, " ", the function splits on whitespace, /\s+/, after skipping any leading whitespace
    sub { $_='俙 俛 俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub { $_='俙 俛 俠'; $_=mb::_split(' '); $_ == 3 },
    sub { $_=' 俙 俛 俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub { $_=' 俙 俛 俠'; $_=mb::_split(' '); $_ == 3 },
    sub { $_='俙  俛  俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub { $_='俙  俛  俠'; $_=mb::_split(' '); $_ == 3 },
    sub { $_=' 俙  俛  俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub {1},
    sub {1},
    sub {1},
# 171
    sub { $_=' 俙  俛  俠'; $_=mb::_split(' '); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 181 strings of any length can be split
    sub { @_=mb::_split(qr//,'倂俷俼俢'); "@_" eq "倂 俷 俼 俢" },
    sub { @_=mb::_split(qr/:/,'倢倝値倕侾:倢倝値倕俀:倢倝値倕俁'); "@_" eq "倢倝値倕侾 倢倝値倕俀 倢倝値倕俁" },
    sub { @_=mb::_split(" ",'  倫倎倰倎倗倰倎倫倛侾  倫倎倰倎倗倰倎倫倛俀  倫倎倰倎倗倰倎倫倛俁  倫倎倰倎倗倰倎倫倛係  '); "@_" eq "倫倎倰倎倗倰倎倫倛侾 倫倎倰倎倗倰倎倫倛俀 倫倎倰倎倗倰倎倫倛俁 倫倎倰倎倗倰倎倫倛係" },
    sub { return 'SKIP'; @_=mb::_split(qr/^/,"俙\n俛\n俠\n俢\n"); "@_" eq "俙\n 俛\n 俠\n 俢\n" },
    sub { @_=mb::_split(qr/^/m,"俙\n俛\n俠\n俢\n"); "@_" eq "俙\n 俛\n 俠\n 俢\n" },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 191 A pattern capable of matching either the null string or something longer
#    than the null string (for instance, a pattern consisting of any single
#    character modified by a * or ?) will split the value of EXPR into separate
#    characters wherever it matches the null string between characters; nonnull
#    matches will skip over the matched separator characters in the usual fashion.
#    (In other words, a pattern won't match in one spot more than once, even if
#    it matched with a zero width.)
    sub { $_=join(':',mb::_split(qr/ */,'倛倝 倲倛倕倰倕')); $_ eq '倛:倝:倲:倛:倕:倰:倕' },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 201 as a trivial case, the null pattern // simply splits into separate characters, and spaces do not disappear
    sub { $_=join(':',mb::_split(qr//,'倛倝 倲倛倕倰倕')); $_ eq '倛:倝: :倲:倛:倕:倰:倕' },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 211 The LIMIT parameter splits only part of a string
    sub { my($a,$b,$c)=mb::_split(qr/:/,'俙:俛:俠:俢:俤:俥',3); "$a $b $c" eq "俙 俛 俠:俢:俤:俥" },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 221 when assigning to a list, if LIMIT is omitted, Perl supplies a LIMIT one
#    larger than the number of variables in the list, to avoid unnecessary work.
#    for the split above, LIMIT would have been 4 by default, and $remainder
#    would have received only the third field, not all the rest of the fields.
    sub { my($a,$b,$c)=mb::_split(qr/:/,'俙:俛:俠:俢:俤:俥'); "$a $b $c" eq "俙 俛 俠" },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 231 but if the PATTERN contains parentheses, then the substring matched by each pair of parentheses is included in the resulting list, interspersed with the fields that are ordinarily returned
    sub { @_=mb::_split(qr/([-,])/,'侾-侾侽,俀侽'); "@_" eq "侾 - 侾侽 , 俀侽" },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 241 with more parentheses, a field is returned for each pair, even if some pairs don't match, in which case undefined values are returned in those positions
    sub { @_=mb::_split(qr/(-)|(,)/,'侾-侾侽,俀侽'); "@_" eq "侾 -  侾侽  , 俀侽" },
    sub { return 'SKIP' if $] =~ /^5\.006/; @_=mb::_split(qr/(-)|(,)/,'侾-侾侽,俀侽'); not(defined($_[2])) },
    sub { return 'SKIP' if $] =~ /^5\.006/; @_=mb::_split(qr/(-)|(,)/,'侾-侾侽,俀侽'); not(defined($_[4])) },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 251 the /PATTERN/ argument may be replaced with an expression to specify patterns that vary at runtime
    sub { my $var='侾'; @_=mb::_split($var,'俙侾俛侾俠'); "@_" eq "俙 俛 俠" },
    sub { for my $var ('侾'    ) { @_=mb::_split(qr/$var/o,'俙侾俛侾俠'); } "@_" eq "俙 俛 俠" },
    sub { return 'SKIP' if $] =~ /^5\.006001/; for my $var ('侾','俀'  ) { @_=mb::_split(qr/$var/o,'俙侾俛侾俠'); } "@_" eq "俙 俛 俠" },
    sub { return 'SKIP' if $] =~ /^5\.006001/; for my $var ('侾','俀','俁') { @_=mb::_split(qr/$var/o,'俙侾俛侾俠'); } "@_" eq "俙 俛 俠" },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 261 as a special case, if the expression is a single space (" "), the function splits on whitespace just as split with no arguments does
    sub { $_='俙 俛 俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub { $_='俙 俛 俠'; $_=mb::_split(' '); $_ == 3 },
    sub { $_=' 俙 俛 俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub { $_=' 俙 俛 俠'; $_=mb::_split(' '); $_ == 3 },
    sub { $_='俙  俛  俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub { $_='俙  俛  俠'; $_=mb::_split(' '); $_ == 3 },
    sub { $_=' 俙  俛  俠'; @_=mb::_split(' '); "@_" eq "俙 俛 俠" },
    sub {1},
    sub {1},
    sub {1},
# 271
    sub { $_=' 俙  俛  俠'; $_=mb::_split(' '); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 281 in contrast, split(qr/ /) will give you as many null initial fields as there are leading spaces
    sub { $_='俙 俛 俠'; @_=mb::_split(qr/ /); "@_" eq "俙 俛 俠" },
    sub { $_='俙 俛 俠'; $_=mb::_split(qr/ /); $_ == 3 },
    sub { $_=' 俙 俛 俠'; @_=mb::_split(qr/ /); "@_" eq " 俙 俛 俠" },
    sub { $_=' 俙 俛 俠'; $_=mb::_split(qr/ /); $_ == 4 },
    sub { $_='俙  俛  俠'; @_=mb::_split(qr/ /); "@_" eq "俙  俛  俠" },
    sub { $_='俙  俛  俠'; $_=mb::_split(qr/ /); $_ == 5 },
    sub { $_=' 俙  俛  俠'; @_=mb::_split(qr/ /); "@_" eq " 俙  俛  俠" },
    sub { $_=' 俙  俛  俠'; $_=mb::_split(qr/ /); $_ == 6 },
    sub { my $var=' '; $_='俙 俛 俠'; @_=mb::_split($var); "@_" eq "俙 俛 俠" },
    sub { my $var=' '; $_='俙 俛 俠'; $_=mb::_split($var); $_ == 3 },
# 291
    sub { return 'PASS'; my $var=' '; $_=' 俙 俛 俠'; @_=mb::_split($var); "@_" eq " 俙 俛 俠" },
    sub { return 'PASS'; my $var=' '; $_=' 俙 俛 俠'; $_=mb::_split($var); $_ == 4 },
    sub { return 'PASS'; my $var=' '; $_='俙  俛  俠'; @_=mb::_split($var); "@_" eq " 俙  俛  俠" },
    sub { return 'PASS'; my $var=' '; $_='俙  俛  俠'; $_=mb::_split($var); $_ == 5 },
    sub { return 'PASS'; my $var=' '; $_=' 俙  俛  俠'; @_=mb::_split($var); "@_" eq " 俙  俛  俠" },
    sub { return 'PASS'; my $var=' '; $_=' 俙  俛  俠'; $_=mb::_split($var); $_ == 6 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
# 301
    sub { my $var=' '; $_=' 俙 俛 俠'; @_=mb::_split($var); "@_" eq "俙 俛 俠" },
    sub { my $var=' '; $_=' 俙 俛 俠'; $_=mb::_split($var); $_ == 3 },
    sub { my $var=' '; $_='俙  俛  俠'; @_=mb::_split($var); "@_" eq "俙 俛 俠" },
    sub { my $var=' '; $_='俙  俛  俠'; $_=mb::_split($var); $_ == 3 },
    sub { my $var=' '; $_=' 俙  俛  俠'; @_=mb::_split($var); "@_" eq "俙 俛 俠" },
    sub { my $var=' '; $_=' 俙  俛  俠'; $_=mb::_split($var); $_ == 3 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 311 you can use this property to remove leading and trailing whitespace from a string and to collapse intervening stretches of whitespace into a single space
    sub { $_=join(' ',mb::_split(' ','  倱  倲  倰  倝  値  倗  ')); $_ eq '倱 倲 倰 倝 値 倗' },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},

# 321 the following example splits an RFC 822 message header into a hash containing $head{Date}, $head{Subject}
#    $header =~ s/\n\s+/ /g; # Merge continuation lines.
#    %head = ("FRONTSTUFF", split /^(\S*?):\s*/m, $header);
    sub { return 'SKIP'; my $header=<<'END'; $header=~s/\n\s+/ /g; my %head = ('FRONTSTUFF', mb::_split(qr/^(\S*?):\s*/m, $header)); qq(@head{'俥倰倧倣','俿倧','俽倳倐倞倕們倲','俢倎倲倕'}) eq qq{俙倢倝們倕仐倕倶倎倣倫倢倕丏們倧倣\n丂俛倧倐仐倕倶倎倣倫倢倕丏們倧倣\n丂倱倎倣倫倢倕丂倓倎倲倎丂倖倧倰丂倲倕倱倲倝値倗丂倲倛倕丂乭倣倐丗丗丵倱倫倢倝倲乭丂倖倳値們倲倝倧値\n丂侾丂俙倫倰丂俀侽俀侽丂侾侾丗俀俀\n} },
俽倛倝倖倲丂俰俬俽
丂丂俥倰倧倣丂倂倝倠倝倫倕倓倝倎丆丂倲倛倕丂倖倰倕倕丂倕値們倷們倢倧倫倕倓倝倎
丂丂俽倛倝倖倲丂俰俬俽丂乮俽倛倝倖倲丂俰倎倫倎値倕倱倕丂俬値倓倳倱倲倰倝倎倢丂俽倲倎値倓倎倰倓倱丆丂倎倢倱倧丂俽俰俬俽丆丂俵俬俵俤丂値倎倣倕丂俽倛倝倖倲丵俰俬俽乯
丂丂倝倱丂倎丂們倛倎倰倎們倲倕倰丂倕値們倧倓倝値倗丂倖倧倰丂倲倛倕丂俰倎倫倎値倕倱倕丂倢倎値倗倳倎倗倕丆丂倧倰倝倗倝値倎倢倢倷丂倓倕倴倕倢倧倫倕倓丂倐倷丂倎
丂丂俰倎倫倎値倕倱倕丂們倧倣倫倎値倷丂們倎倢倢倕倓丂俙俽俠俬俬丂俠倧倰倫倧倰倎倲倝倧値丂倝値丂們倧値倞倳値們倲倝倧値丂倵倝倲倛丂俵倝們倰倧倱倧倖倲丂倎値倓
丂丂倱倲倎値倓倎倰倓倝倸倕倓丂倎倱丂俰俬俽丂倃丂侽俀侽俉丂俙倫倫倕値倓倝倶丂侾丏
俥倰倧倣:丂俙倢倝們倕仐倕倶倎倣倫倢倕丏們倧倣
俿倧:丂俛倧倐仐倕倶倎倣倫倢倕丏們倧倣
俽倳倐倞倕們倲:丂倱倎倣倫倢倕丂倓倎倲倎丂倖倧倰丂倲倕倱倲倝値倗丂倲倛倕丂乭倣倐丗丗丵倱倫倢倝倲乭丂倖倳値們倲倝倧値
俢倎倲倕:丂侾丂俙倫倰丂俀侽俀侽丂侾侾丗俀俀
END
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
    sub {1},
);

$|=1; print "1..",scalar(@test),"\n"; my $testno=1; sub ok { print $_[0]?'ok ':'not ok ',$testno++,$_[1]?" - $_[1]\n":"\n" } ok($_->()) for @test;

__END__
