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

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

#####

%ran = (
    ShiftJIS => {
	dH => "0-9", dZ => "\x82\x4F-\x82\x58",
	uH => "A-Z", uZ => "\x82\x60-\x82\x79",
	lH => "a-z", lZ => "\x82\x81-\x82\x9A",
    },
    EUC => {
	dH => "0-9", dZ => "\xA3\xB0-\xA3\xB9",
	uH => "A-Z", uZ => "\xA3\xC1-\xA3\xDA",
	lH => "a-z", lZ => "\xA3\xE1-\xA3\xFA",
    },
    EUC_JP => {
	dH => "0-9", dZ => "\xA3\xB0-\xA3\xB9",
	uH => "A-Z", uZ => "\xA3\xC1-\xA3\xDA",
	lH => "a-z", lZ => "\xA3\xE1-\xA3\xFA",
    },
    Bytes => {
	dH => "0-9", dZ => "0-9",
	uH => "A-Z", uZ => "A-Z",
	lH => "a-z", lZ => "a-z",
    },
    UTF8 => {
	dH => "0-9", dZ => "\xEF\xBC\x90-\xEF\xBC\x99",
	uH => "A-Z", uZ => "\xEF\xBC\xA1-\xEF\xBC\xBA",
	lH => "a-z", lZ => "\xEF\xBD\x81-\xEF\xBD\x9A",
    },
    UTF16BE => {
	dH => "\0\x30\0-\0\x39", dZ => "\xFF\x10\x00\x2D\xFF\x19",
	uH => "\0\x41\0-\0\x5A", uZ => "\xFF\x21\x00\x2D\xFF\x3A",
	lH => "\0\x61\0-\0\x7A", lZ => "\xFF\x41\x00\x2D\xFF\x5A",
    },
    UTF16LE => {
	dH => "\x30\0-\0\x39\0", dZ => "\x10\xFF\x2D\x00\x19\xFF",
	uH => "\x41\0-\0\x5A\0", uZ => "\x21\xFF\x2D\x00\x3A\xFF",
	lH => "\x61\0-\0\x7A\0", lZ => "\x41\xFF\x2D\x00\x5A\xFF",
    },
    UTF32BE => {
	dH => "\0\0\0\x30\0\0\0-\0\0\0\x39",
	dZ => "\0\0\xFF\x10\0\0\x00\x2D\0\0\xFF\x19",
	uH => "\0\0\0\x41\0\0\0-\0\0\0\x5A",
	uZ => "\0\0\xFF\x21\0\0\x00\x2D\0\0\xFF\x3A",
	lH => "\0\0\0\x61\0\0\0-\0\0\0\x7A",
	lZ => "\0\0\xFF\x41\0\0\x00\x2D\0\0\xFF\x5A",
    },
    UTF32LE => {
	dH => "\x30\0\0\0-\0\0\0\x39\0\0\0",
	dZ => "\x10\xFF\0\0\x2D\x00\0\0\x19\xFF\0\0",
	uH => "\x41\0\0\0-\0\0\0\x5A\0\0\0",
	uZ => "\x21\xFF\0\0\x2D\x00\0\0\x3A\xFF\0\0",
	lH => "\x61\0\0\0-\0\0\0\x7A\0\0\0",
	lZ => "\x41\xFF\0\0\x2D\x00\0\0\x5A\xFF\0\0",
    },
    Unicode => $] < 5.008 ? {}  : {
	dH => "0-9", dZ => pack('U*', 0xFF10, 0x2D, 0xFF19),
	uH => "A-Z", uZ => pack('U*', 0xFF21, 0x2D, 0xFF3A),
	lH => "a-z", lZ => pack('U*', 0xFF41, 0x2D, 0xFF5A),
    },
);

#####

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

    my $digitH = $mb->mkrange($ran{$cs}{dH});
    my $digitZ = $mb->mkrange($ran{$cs}{dZ});
    my $upperH = $mb->mkrange($ran{$cs}{uH});
    my $upperZ = $mb->mkrange($ran{$cs}{uZ});
    my $lowerH = $mb->mkrange($ran{$cs}{lH});
    my $lowerZ = $mb->mkrange($ran{$cs}{lZ});
    my $alphaH = $mb->mkrange($ran{$cs}{uH}.$ran{$cs}{lH});
    my $alphaZ = $mb->mkrange($ran{$cs}{uZ}.$ran{$cs}{lZ});
    my $alnumH = $mb->mkrange(join '', @{ $ran{$cs} }{qw/dH uH lH/});
    my $alnumZ = $mb->mkrange(join '', @{ $ran{$cs} }{qw/dZ uZ lZ/});

    my $digitZ2H = $mb->trclosure($digitZ, $digitH);
    my $upperZ2H = $mb->trclosure($upperZ, $upperH);
    my $lowerZ2H = $mb->trclosure($lowerZ, $lowerH);
    my $alphaZ2H = $mb->trclosure($alphaZ, $alphaH);
    my $alnumZ2H = $mb->trclosure($alnumZ, $alnumH);

    my $digitH2Z = $mb->trclosure($digitH, $digitZ);
    my $upperH2Z = $mb->trclosure($upperH, $upperZ);
    my $lowerH2Z = $mb->trclosure($lowerH, $lowerZ);
    my $alphaH2Z = $mb->trclosure($alphaH, $alphaZ);
    my $alnumH2Z = $mb->trclosure($alnumH, $alnumZ);

    my($H, $Z, $tr, $NG);
    $NG = 0;
    for $H ($digitH, $lowerH, $upperH) {
	for $tr ($digitZ2H, $upperZ2H,
		 $lowerZ2H, $alphaZ2H, $alnumZ2H) {
	    ++$NG unless $H eq &$tr($H);
	}
    }
    print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    $NG = 0;
    for $Z ($digitZ, $lowerZ, $upperZ) {
	for $tr ($digitH2Z, $upperH2Z,
		 $lowerH2Z, $alphaH2Z, $alnumH2Z) {
	    ++$NG unless $Z eq &$tr($Z);
	}
    }
    print ! $NG ? "ok" : "not ok", " ", ++$loaded, "\n";

    print  $digitZ eq &$digitH2Z($digitH)
	&& $digitH eq &$upperH2Z($digitH)
	&& $digitH eq &$lowerH2Z($digitH)
	&& $digitH eq &$alphaH2Z($digitH)
	&& $digitZ eq &$alnumH2Z($digitH)
	  ? "ok" : "not ok", " ", ++$loaded, "\n";

    print  $upperH eq &$digitH2Z($upperH)
	&& $upperZ eq &$upperH2Z($upperH)
	&& $upperH eq &$lowerH2Z($upperH)
	&& $upperZ eq &$alphaH2Z($upperH)
	&& $upperZ eq &$alnumH2Z($upperH)
	  ? "ok" : "not ok", " ", ++$loaded, "\n";

    print  $lowerH eq &$digitH2Z($lowerH)
	&& $lowerH eq &$upperH2Z($lowerH)
	&& $lowerZ eq &$lowerH2Z($lowerH)
	&& $lowerZ eq &$alphaH2Z($lowerH)
	&& $lowerZ eq &$alnumH2Z($lowerH)
	  ? "ok" : "not ok", " ", ++$loaded, "\n";

    print  $digitH eq &$digitZ2H($digitZ)
	&& $digitZ eq &$upperZ2H($digitZ)
	&& $digitZ eq &$lowerZ2H($digitZ)
	&& $digitZ eq &$alphaZ2H($digitZ)
	&& $digitH eq &$alnumZ2H($digitZ)
	  ? "ok" : "not ok", " ", ++$loaded, "\n";

    print  $upperZ eq &$digitZ2H($upperZ)
	&& $upperH eq &$upperZ2H($upperZ)
	&& $upperZ eq &$lowerZ2H($upperZ)
	&& $upperH eq &$alphaZ2H($upperZ)
	&& $upperH eq &$alnumZ2H($upperZ)
	  ? "ok" : "not ok", " ", ++$loaded, "\n";

    print  $lowerZ eq &$digitZ2H($lowerZ)
	&& $lowerZ eq &$upperZ2H($lowerZ)
	&& $lowerH eq &$lowerZ2H($lowerZ)
	&& $lowerH eq &$alphaZ2H($lowerZ)
	&& $lowerH eq &$alnumZ2H($lowerZ)
	  ? "ok" : "not ok", " ", ++$loaded, "\n";
}

1;
__END__