view release on metacpan or  search on metacpan

t/overload_precision.t  view on Meta::CPAN

use strict;
use warnings;

use Config;
use Test::More;

use Algorithm::Heapify::XS qw(
    max_heapify
    max_heap_shift
    max_heap_push
    max_heap_adjust_item
    max_heap_adjust_top
    maxstr_heapify
    maxstr_heap_shift
    maxstr_heap_push
    maxstr_heap_adjust_item
    maxstr_heap_adjust_top
    min_heapify
    min_heap_shift
    min_heap_push
    min_heap_adjust_item
    min_heap_adjust_top
    minstr_heapify
    minstr_heap_shift
    minstr_heap_push
    minstr_heap_adjust_item
    minstr_heap_adjust_top
);

{
    package Local::BigNumOnly;

    use overload
        '0+' => sub { ${$_[0]} },
        '""' => sub { ${$_[0]} },
        fallback => 1;

    sub new {
        my ($class, $value) = @_;
        return bless \$value, $class;
    }
}

{
    package Local::BigNumCmp;

    use overload
        '<=>' => sub {
            my ($left, $right, $swap) = @_;
            ($left, $right) = ($right, $left) if $swap;
            return ${$left} <=> ${$right};
        },
        '""' => sub { ${$_[0]} },
        fallback => 1;

    sub new {
        my ($class, $value) = @_;
        return bless \$value, $class;
    }
}

{
    package Local::BigStrCmp;

    use overload
        'cmp' => sub {
            my ($left, $right, $swap) = @_;
            ($left, $right) = ($right, $left) if $swap;
            return ${$left} cmp ${$right};
        },
        '""' => sub { ${$_[0]} },
        fallback => 1;

    sub new {
        my ($class, $value) = @_;
        return bless \$value, $class;
    }
}

my $nv_preserves_64bit_uv =
    ($Config{nvsize} * 8) >= 64
    && (~0 <= 9_007_199_254_740_992);

plan skip_all => 'needs UV values larger than NV can exactly represent'
    if $nv_preserves_64bit_uv;

my $big = ~0;
my @values = ($big - 1, $big, $big - 2, $big - 3, $big - 4);
my @expect_max = ($big, $big - 1, $big - 2, $big - 3, $big - 4);
my @expect_min = reverse @expect_max;

sub drain_max_num {
    my (@heap) = @_;
    my @got;
    push @got, 0 + max_heap_shift(@heap) while @heap;
    return @got;
}

sub drain_min_num {
    my (@heap) = @_;
    my @got;
    push @got, 0 + min_heap_shift(@heap) while @heap;
    return @got;
}

sub drain_max_str {
    my (@heap) = @_;
    my @got;
    push @got, '' . maxstr_heap_shift(@heap) while @heap;
    return @got;
}

sub drain_min_str {
    my (@heap) = @_;
    my @got;
    push @got, '' . minstr_heap_shift(@heap) while @heap;
    return @got;
}

sub find_idx {
    my ($heap, $want) = @_;
    for my $idx (0 .. $#$heap) {
        return $idx if "$heap->[$idx]" eq "$want";
    }
    die "value $want not found in heap";
}

{
    my @heap = map Local::BigNumOnly->new($_), @values;

    max_heapify(@heap);

    is_deeply(
        [ drain_max_num(@heap) ],
        \@expect_max,
        'max heap keeps overloaded large UVs in numeric order',