# This file is encoded in UTF-8.
die "This file is not encoded in UTF-8.\n" if 'あ' ne "\xe3\x81\x82";
die "This script is for perl only. You are using $^X.\n" if $^X =~ /jperl/i;

# Runtime test for mb::split() (path-3 entry point, UTF8::R2 compatible).
#
# mb::split(PATTERN, EXPR, LIMIT) splits on UTF-8 codepoints when PATTERN is ''
# or an empty (?^...:) group, otherwise it delegates to CORE::split using
# mb::qr(PATTERN). This exercises all argument counts (0..3), the LIMIT (positive,
# negative, exceeding), and both scalar and list context. mb is loaded with
# require (no source filter), so plain split() here is CORE::split (used only as
# the ASCII baseline) and runs on every perl from 5.005_03 up.

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

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

@test = (
# 1 -- list context, empty pattern, ASCII (baseline vs CORE split)
    sub { $_='ABCDE'; my @r=          split(//);        "@r" eq "A B C D E"  },
    sub { $_='ABCDE'; my @r=          split(//,$_);     "@r" eq "A B C D E"  },
    sub { $_='ABCDE'; my @r=          split(//,$_,3);   "@r" eq "A B CDE"    },
    sub { $_='ABCDE'; my @r=mb::split('');        "@r" eq "A B C D E"  },
    sub { $_='ABCDE'; my @r=mb::split('',$_);     "@r" eq "A B C D E"  },
    sub { $_='ABCDE'; my @r=mb::split('',$_,3);   "@r" eq "A B CDE"    },
    sub { $_='ABCDE'; my @r=mb::split(qr//);      "@r" eq "A B C D E"  },
    sub { $_='ABCDE'; my @r=mb::split(qr//,$_);   "@r" eq "A B C D E"  },
    sub { $_='ABCDE'; my @r=mb::split(qr//,$_,3); "@r" eq "A B CDE"    },
    sub {1},
# 11 -- scalar context returns the field count
    sub {              $_='ABCDE'; my $r=          split(//);        $r == 5 },
    sub {              $_='ABCDE'; my $r=          split(//,$_);     $r == 5 },
    sub {              $_='ABCDE'; my $r=          split(//,$_,3);   $r == 3 },
    sub { local $^W=0; $_='ABCDE'; my $r=mb::split('');        $r == 5 },
    sub { local $^W=0; $_='ABCDE'; my $r=mb::split('',$_);     $r == 5 },
    sub { local $^W=0; $_='ABCDE'; my $r=mb::split('',$_,3);   $r == 3 },
    sub { local $^W=0; $_='ABCDE'; my $r=mb::split(qr//);      $r == 5 },
    sub { local $^W=0; $_='ABCDE'; my $r=mb::split(qr//,$_);   $r == 5 },
    sub { local $^W=0; $_='ABCDE'; my $r=mb::split(qr//,$_,3); $r == 3 },
    sub {1},
# 21 -- list context, codepoint split on mixed ASCII + multibyte
    sub { $_='AあBｱｲうえC'; my @r=mb::split('');        "@r" eq "A あ B ｱ ｲ う え C" },
    sub { $_='AあBｱｲうえC'; my @r=mb::split('',$_);     "@r" eq "A あ B ｱ ｲ う え C" },
    sub { $_='AあBｱｲうえC'; my @r=mb::split('',$_,5);   "@r" eq "A あ B ｱ ｲうえC"    },
    sub { $_='AあBｱｲうえC'; my @r=mb::split(qr//);      "@r" eq "A あ B ｱ ｲ う え C" },
    sub { $_='AあBｱｲうえC'; my @r=mb::split(qr//,$_);   "@r" eq "A あ B ｱ ｲ う え C" },
    sub { $_='AあBｱｲうえC'; my @r=mb::split(qr//,$_,5); "@r" eq "A あ B ｱ ｲうえC"    },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
# 31 -- scalar context, codepoint count for the multibyte string
    sub { local $^W=0; $_='AあBｱｲうえC'; my $r=mb::split('');        $r == 8 },
    sub { local $^W=0; $_='AあBｱｲうえC'; my $r=mb::split('',$_);     $r == 8 },
    sub { local $^W=0; $_='AあBｱｲうえC'; my $r=mb::split('',$_,5);   $r == 5 },
    sub { local $^W=0; $_='AあBｱｲうえC'; my $r=mb::split(qr//);      $r == 8 },
    sub { local $^W=0; $_='AあBｱｲうえC'; my $r=mb::split(qr//,$_);   $r == 8 },
    sub { local $^W=0; $_='AあBｱｲうえC'; my $r=mb::split(qr//,$_,5); $r == 5 },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
# 41 -- delegated CORE::split via mb::qr (ASCII patterns, LIMIT, trailing empties)
    sub { my $r=join(':',mb::split(qr/b/,'abc'));             $r eq 'a:c'           },
    sub { my $r=join(':',mb::split(qr//,'abc'));              $r eq 'a:b:c'         },
    sub { my $r=join(':',mb::split(qr//,'abc',1));            $r eq 'abc'           },
    sub { my $r=join(':',mb::split(qr//,'abc',2));            $r eq 'a:bc'          },
    sub { my $r=join(':',mb::split(qr//,'abc',3));            $r eq 'a:b:c'         },
    sub { my $r=join(':',mb::split(qr//,'abc',4));            $r eq 'a:b:c'         },
    sub { my $r=join(':',mb::split(qr/,/,'a,b,c,,,'));        $r eq 'a:b:c'         },
    sub { my $r=join(':',mb::split(qr/,/,'a,b,c,,,',-1));     $r eq 'a:b:c:::'      },
    sub { my $r=join(':',mb::split(qr/ /, ' abc'));           $r eq ':abc'          },
    sub { my $r=join(':',mb::split(qr//,' abc'));             $r eq ' :a:b:c'       },
# 51 -- negative LIMIT, alternation, capturing groups
    sub { my $r=join(':',mb::split(qr//,' abc',-1));          $r eq ' :a:b:c'       },
    sub { my $r=join(':',mb::split(qr/-|,/,"1-10,20",3));     $r eq '1:10:20'       },
    sub { my $r=join(':',mb::split(qr/(-|,)/,"1-10,20",3));   $r eq '1:-:10:,:20'   },
    sub { my $r=join(':',mb::split(qr/-|(,)/,"1-10,20",3));   $r eq '1::10:,:20'    },
    sub { my $r=join(':',mb::split(qr/(-)|,/,"1-10,20",3));   $r eq '1:-:10::20'    },
    sub { my $r=join(':',mb::split(qr/(-)|(,)/,"1-10,20",3)); $r eq '1:-::10::,:20' },
    sub {1},
    sub {1},
    sub {1},
    sub {1},
# 61 -- the same patterns over full-width (multibyte) text via mb::qr
    sub { my $r=join('：',mb::split(qr/ｂ/,'ａｂｃ'));                  $r eq 'ａ：ｃ'                     },
    sub { my $r=join('：',mb::split(qr//,'ａｂｃ'));                    $r eq 'ａ：ｂ：ｃ'                 },
    sub { my $r=join('：',mb::split(qr//,'ａｂｃ',1));                  $r eq 'ａｂｃ'                     },
    sub { my $r=join('：',mb::split(qr//,'ａｂｃ',2));                  $r eq 'ａ：ｂｃ'                   },
    sub { my $r=join('：',mb::split(qr//,'ａｂｃ',3));                  $r eq 'ａ：ｂ：ｃ'                 },
    sub { my $r=join('：',mb::split(qr//,'ａｂｃ',4));                  $r eq 'ａ：ｂ：ｃ'                 },
    sub { my $r=join('：',mb::split(qr/，/,'ａ，ｂ，ｃ，，，'));        $r eq 'ａ：ｂ：ｃ'                 },
    sub { my $r=join('：',mb::split(qr/，/,'ａ，ｂ，ｃ，，，',-1));     $r eq 'ａ：ｂ：ｃ：：：'           },
    sub { my $r=join('：',mb::split(qr/　/, '　ａｂｃ'));               $r eq '：ａｂｃ'                   },
    sub { my $r=join('：',mb::split(qr//,'　ａｂｃ'));                  $r eq '　：ａ：ｂ：ｃ'             },
# 71 -- negative LIMIT and capturing groups over full-width text
    sub { my $r=join('：',mb::split(qr//,'　ａｂｃ',-1));               $r eq '　：ａ：ｂ：ｃ'             },
    sub { my $r=join('：',mb::split(qr/－|，/,"１－１０，２０",3));     $r eq '１：１０：２０'             },
    sub { my $r=join('：',mb::split(qr/(－|，)/,"１－１０，２０",3));   $r eq '１：－：１０：，：２０'     },
    sub { my $r=join('：',mb::split(qr/－|(，)/,"１－１０，２０",3));   $r eq '１：：１０：，：２０'       },
    sub { my $r=join('：',mb::split(qr/(－)|，/,"１－１０，２０",3));   $r eq '１：－：１０：：２０'       },
    sub { my $r=join('：',mb::split(qr/(－)|(，)/,"１－１０，２０",3)); $r eq '１：－：：１０：：，：２０' },
    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" } for my $t (@test) { ok($t->()); }

__END__
