view release on metacpan or  search on metacpan

t/01-basic.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use Data::HierTimingWheel::Shared;

# constructor + introspection
{
    my $tw = Data::HierTimingWheel::Shared->new(undef, 16, 3, 100);
    isa_ok $tw, 'Data::HierTimingWheel::Shared';
    is $tw->num_slots, 16, 'num_slots';
    is $tw->num_levels, 3, 'num_levels';
    is $tw->max_delay, 16 ** 3 - 1, 'max_delay == S**L - 1';
    is $tw->capacity, 100, 'capacity';
    is $tw->now, 0, 'fresh: now 0';
    is $tw->count, 0, 'fresh: no timers';
    is_deeply [$tw->advance(1)], [], 'advancing an empty wheel fires nothing';
    is $tw->now, 1, 'advance moves the clock';
}

# THE ORACLE: a timer fires exactly `delay` ticks after scheduling, across delays
# that span every level and force cascades.  Tiny wheel (S=4, L=3, max 63) so the
# 63-delay timer drops through all three levels.
{
    my $S = 4;
    my $tw = Data::HierTimingWheel::Shared->new(undef, $S, 3, 1000);
    my %expect;   # payload -> the tick it must fire on (== its delay)
    my $p = 1;
    for my $delay (1, 2, 3, 4, 5, 7, 8, 15, 16, 17, 31, 32, 48, 63) {
        $tw->add($delay, $p);
        $expect{$p} = $delay;
        $p++;
    }
    is $tw->count, scalar(keys %expect), 'all timers pending';

    my %got;
    for my $t (1 .. 70) { $got{$_} = $t for $tw->advance(1) }
    my $bad = 0;
    for my $pl (keys %expect) { $bad++ if ($got{$pl} // -1) != $expect{$pl} }
    is $bad, 0, 'every timer fires on exactly its delay tick (S=4, L=3, all levels + cascades)';
    is $tw->count, 0, 'all timers fired';
    is $tw->now, 70, 'clock advanced 70 ticks';
}

# a second oracle at a wider geometry (S=8, L=3, max 511), delays landing in
# level 2 and cascading down through levels 1 and 0
{
    my $tw = Data::HierTimingWheel::Shared->new(undef, 8, 3, 1000);
    my %expect;
    my $p = 1;
    for my $delay (1, 8, 9, 63, 64, 65, 100, 200, 511) { $tw->add($delay, $p); $expect{$p} = $delay; $p++ }
    my %got;
    for my $t (1 .. 511) { $got{$_} = $t for $tw->advance(1) }
    my $bad = 0;
    for my $pl (keys %expect) { $bad++ if ($got{$pl} // -1) != $expect{$pl} }
    is $bad, 0, 'exact timing for delays up to 511 across 3 levels';
}

# delay < 1 is treated as 1
{
    my $tw = Data::HierTimingWheel::Shared->new(undef, 8, 2, 10);
    $tw->add(0, 42);
    is_deeply [$tw->advance(1)], [42], 'delay 0 fires on the next tick';
}

# advance by many ticks returns everything due, in tick order
{
    my $tw = Data::HierTimingWheel::Shared->new(undef, 4, 3, 100);
    $tw->add(1, 10);
    $tw->add(2, 20);
    $tw->add(3, 30);
    $tw->add(20, 200);
    my @due = $tw->advance(3);
    is_deeply [sort { $a <=> $b } @due], [10, 20, 30], 'advance(3) fires the first three';
    is $tw->count, 1, 'the 20-tick timer is still pending (in a higher level)';
    my @later;
    push @later, $tw->advance(1) for 1 .. 17;   # reach tick 20
    is_deeply \@later, [200], 'the far timer fires at exactly tick 20 after cascading down';
}

# schedule alias
{
    my $tw = Data::HierTimingWheel::Shared->new(undef, 16, 2, 10);
    $tw->schedule(2, 7);
    $tw->advance(1);
    is_deeply [$tw->advance(1)], [7], 'schedule is an alias for add';
}

# cancel (including a timer parked in a higher level)
{
    my $tw = Data::HierTimingWheel::Shared->new(undef, 4, 3, 100);
    my $a = $tw->add(40, 111);   # lands in a high level
    my $b = $tw->add(40, 222);
    is $tw->count, 2, 'two timers pending';
    is $tw->cancel($a), 1, 'cancel a high-level timer returns 1';
    is $tw->count, 1, 'count drops after cancel';
    is $tw->cancel($a), 0, 're-cancelling returns 0';
    is $tw->cancel(99999), 0, 'cancelling an invalid id returns 0';
    my @fired;
    push @fired, $tw->advance(1) for 1 .. 40;