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;

    given($total) { 
        when ($passed)  { print "passed all $total codepoints" }
        when ($failed)  { print "failed all $total codepoints" }

        default         { 
            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);
}