The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use vars qw($loaded);
$^W = 1;

BEGIN { $| = 1; print "1..16\n"; }
END {print "not ok 1\n" unless $loaded;}
use ShiftJIS::Collate;
$loaded = 1;
print "ok 1\n";

####

my ($mod, $k, $kstr, $match, @tmp, @pos);
$mod = "ShiftJIS::Collate";
$kstr = "* ‚Ђ炪‚È  ‚ƃJƒ^ƒJƒi‚̓Œƒxƒ‹‚R‚Å‚Í“™‚µ‚¢‚©‚ȁB";
$k = "‚©‚È";

@pos = (position_in_bytes => 1);

if (@tmp = $mod->new(@pos, level => 1)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq '‚ª‚È' ? "ok" : "not ok", " 2\n";

if (@tmp = $mod->new(@pos, level => 2)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
  print $match eq 'ƒJƒi' ? "ok" : "not ok", " 3\n";

if (@tmp = $mod->new(@pos, level => 3)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq 'ƒJƒi' ? "ok" : "not ok", " 4\n";

if (@tmp = $mod->new(@pos, level => 4)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq '‚©‚È' ? "ok" : "not ok", " 5\n";

if (@tmp = $mod->new(@pos, level => 5)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq '‚©‚È' ? "ok" : "not ok", " 6\n";

$kstr = "* ‚Ђç¶Þ‚È  ‚ƃJƒ^ƒJƒi‚̓Œƒxƒ‹‚R‚Å‚Í“™‚µ‚¢‚©‚ȁB";
$k = "‚©‚È";

if (@tmp = $mod->new(@pos, level => 1)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq '¶Þ‚È' ? "ok" : "not ok", " 7\n";

$kstr = "* ‚Ђ炪‚ȂƃJƒ^ƒJƒi‚̓Œƒxƒ‹‚R‚Å‚Í“™‚µ‚¢‚©‚ȁB";
$k = "¶ÞÅ";

if (@tmp = $mod->new(@pos, level => 1)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq '‚ª‚È' ? "ok" : "not ok", " 8\n";

$kstr = "* ‚Ђ炪‚ȂƃJƒ^ƒJƒi‚̓Œƒxƒ‹‚R‚Å‚Í“™‚µ‚¢‚©‚ȁB";
$k = "¶ÞÅ";

$match = undef;
if (@tmp = $mod->new(@pos, level => 4)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print ! defined $match ? "ok" : "not ok", " 9\n";

$kstr = 'ƒp[ƒ‹ƒvƒƒOƒ‰ƒ~ƒ“ƒO';
$k = 'ƒAƒ‹‚Ó';

$match = undef;
if (@tmp = $mod->new(@pos, level => 1)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq '[ƒ‹ƒv' ? "ok" : "not ok", " 10\n";

$match = undef;
if (@tmp = $mod->new(@pos, level => 3)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print ! defined $match ? "ok" : "not ok", " 11\n";

$kstr = 'Êß°ÙÌßÛ¸Þ×ÐݸÞ'; # '¸Þ' is a single grapheme.
$k = 'ÌßÛ¸';

$match = undef;
if (@tmp = $mod->new(@pos, level => 1)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq 'ÌßÛ¸Þ' ? "ok" : "not ok", " 12\n";

$match = undef;
if (@tmp = $mod->new(@pos, level => 2)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print ! defined $match ? "ok" : "not ok", " 13\n";


$kstr = 'Êß°ÙÌßÛ¸Þ×ÐݸÞ';
$k = 'ßÛ¸';
# 'ß' is treated as a grapheme only when it can't combin with preceding kana.
# but it's ignorable.

$match = undef;
if (@tmp = $mod->new(@pos, level => 1)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq 'Û¸Þ' ? "ok" : "not ok", " 14\n";

$kstr = 'Ê߰قÓßÛ¸Þ×ÐݸÞ';
$k = 'ßÛ¸';

$match = undef;
if (@tmp = $mod->new(@pos, level => 1)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq 'Û¸Þ' ? "ok" : "not ok", " 15\n";

$kstr = "‚¤A‚ñ[\0\0\0[\0„£B";
$k = 'ÝÝ¡';

$match = undef;
if (@tmp = $mod->new(@pos, level => 2)->index($kstr, $k)) {
    $match = substr($kstr, $tmp[0], $tmp[1]);
}
print $match eq "[\0\0\0[\0„£B" ? "ok" : "not ok", " 16\n";