use 5.10.0;
use strict;
use autodie;
use warnings FATAL => "all";
use utf8;
use Carp;
binmode(STDOUT, ":utf8");
END { close STDOUT }
$\ = "\n";
sub ghex(_);
my @penults = map {
    (0x01_0000 * $_) + 0xfffE,
    (0x01_0000 * $_) + 0xfffF,
} 0x00 .. 0x10;
my @super_penults = map {
    (0x01_0000 * $_) + 0xfffE,
    (0x01_0000 * $_) + 0xfffF,
} 0x10 .. 0xFF;
my @low_surrogates  = map { 0xDC00 + $_ } 0x000 .. 0x3FF;
my @high_surrogates = map { 0xD800 + $_ } 0x000 .. 0x3FF;
my @surrogates = (@low_surrogates, @high_surrogates);
my @noncharacters = map { 0xFDD0 + $_ } 0x00 .. 0x1F;
my @supers = (
    0x0011_0000,   # first super
    0x0100_0000,
    0x1000_0000,
    0x1F00_0000,
    0x1FFF_FF00,
    0x3FFF_FF00,
    0x7FFF_FF00,
    0x7FFF_FFFF,   # last super should fail due to (N & 0xFFFE) being true
);
# these should always work
my @ὑπέρμεγας = (
    0x8000_0000,   # first hyper
    0xF000_0000,
    0xFFFF_FF00,   # last hyper on 32 bit machines
);
# now we go fishing for 64-bit ὑπέρμεγας
# ignore overflow warnings
eval q{
    use warnings FATAL => "overflow";
    no  warnings "portable";
    push @ὑπέρμεγας => (
        0x01_0000_0000,
        0x01_FFFF_FF00,
        0x10_0000_0000,
    );
};
eval q{
    use warnings FATAL => "overflow";
    no  warnings "portable";
    push @ὑπέρμεγας => (
        0x0001_0000_0000_0000,
        0x7FFF_FFFF_FFFF_FF00,
        0xFFFF_FFFF_FFFF_FF00,
    );
};
# more than 64?
eval q{
    use warnings FATAL => "overflow";
    no  warnings "portable";
    push @ὑπέρμεγας => (
        0x01_0001_0000_0000_0000,
        0x01_7FFF_FFFF_FFFF_FF00,
        0x01_FFFF_FFFF_FFFF_FF00,
    );
    1;
};
my @testpairs = (
    penults         => \@penults,
    super_penults   => \@super_penults,
    noncharacters   => \@noncharacters ,
    low_surrogates  => \@low_surrogates,
    high_surrogates => \@high_surrogates,
    supers          => \@supers,
    ὑπέρμεγας       => \@ὑπέρμεγας,
);
while (my($name, $aref) = splice(@testpairs, 0, 2)) {
    printf "testing %-20s", ucfirst $name;
    my(@passed, @failed);
    for my $codepoint (@$aref) {
        my $char = do {
            #no warnings "utf8";
            chr($codepoint);
        };
        push @{ defined($char) ? \@passed : \@failed }, $codepoint;
    }
    my $total  = @$aref;
    my $passed = @passed;
    my $failed = @failed;
    for($total) {
        if ($passed)  { print "passed all $total codepoints" }
        elsif ($failed)  { print "failed all $total codepoints" }
        else         {
            print "of $total codepoints, failed $failed and passed $passed";
            my $flist = join(", ", map { ghex } @failed);
            my $plist = join(", ", map { ghex } @passed);
            print "\tpassed: $plist";
            print "\tfailed: $flist";
        }
    }
}
sub ghex(_) {
    my $num = shift();
    my $hex = sprintf("%X", $num);
    return $hex if length($hex) < 5;
    my $flip = reverse $hex;
    $flip =~ s<
        ( \p{ahex} \p{ahex} \p{ahex} \p{ahex} )
        (?= \p{ahex} )
        (?! \p{ahex}* \. )
    ><${1}_>gx;
    return "0x" . reverse($flip);
}