view release on metacpan or  search on metacpan

t/20-new-features.t  view on Meta::CPAN

# ============================================================
# put_ttl (per-key TTL)
# ============================================================

# keyword put_ttl - entry expires independently
{
    my $m = Data::HashMap::II->new();
    hm_ii_put_ttl $m, 1, 10, 1;
    hm_ii_put $m, 2, 20;
    my $v1 = hm_ii_get $m, 1;
    is($v1, 10, 'II put_ttl before expiry');
    my $v2 = hm_ii_get $m, 2;
    is($v2, 20, 'II no-ttl before expiry');
    sleep 2;
    $v1 = hm_ii_get $m, 1;
    is($v1, undef, 'II put_ttl expired');
    $v2 = hm_ii_get $m, 2;
    is($v2, 20, 'II no-ttl survives');
}

# keyword put_ttl - string/string
{
    my $m = Data::HashMap::SS->new();
    hm_ss_put_ttl $m, "a", "b", 1;
    hm_ss_put $m, "c", "d";
    sleep 2;
    my $v1 = hm_ss_get $m, "a";
    is($v1, undef, 'SS put_ttl expired');
    my $v2 = hm_ss_get $m, "c";
    is($v2, "d", 'SS no-ttl survives');
}

# keyword put_ttl - int/SV*
{
    my $m = Data::HashMap::IA->new();
    hm_ia_put_ttl $m, 1, [1], 1;
    sleep 2;
    my $v = hm_ia_get $m, 1;
    is($v, undef, 'IA put_ttl expired');
}

# keyword put_ttl - string/SV*
{
    my $m = Data::HashMap::SA->new();
    hm_sa_put_ttl $m, "k", {a=>1}, 1;
    sleep 2;
    my $v = hm_sa_get $m, "k";
    is($v, undef, 'SA put_ttl expired');
}

# put_ttl on map with default_ttl - per-key overrides default
{
    my $m = Data::HashMap::II->new(0, 60);
    hm_ii_put_ttl $m, 1, 10, 1;
    hm_ii_put $m, 2, 20;
    sleep 2;
    my $v1 = hm_ii_get $m, 1;
    is($v1, undef, 'II put_ttl overrides default TTL (expired)');
    my $v2 = hm_ii_get $m, 2;
    is($v2, 20, 'II default TTL still alive');
}

# put_ttl with LRU
{
    my $m = Data::HashMap::II->new(10);
    hm_ii_put_ttl $m, 1, 10, 1;
    sleep 2;
    my $v = hm_ii_get $m, 1;
    is($v, undef, 'II put_ttl with LRU expired');
}

# method put_ttl
{
    my $m = Data::HashMap::I32->new();
    $m->put_ttl(1, 10, 1);
    is($m->get(1), 10, 'I32 method put_ttl before expiry');
    sleep 2;
    is($m->get(1), undef, 'I32 method put_ttl expired');
}

# to_hash skips put_ttl expired entries
{
    my $m = Data::HashMap::II->new();
    hm_ii_put_ttl $m, 1, 10, 1;
    hm_ii_put $m, 2, 20;
    sleep 2;
    my $h = hm_ii_to_hash $m;
    is_deeply($h, {2 => 20}, 'II to_hash skips put_ttl expired');
}

# ============================================================
# get_or_set
# ============================================================

# keyword get_or_set - inserts if missing
{
    my $m = Data::HashMap::II->new();
    my $v = hm_ii_get_or_set $m, 1, 42;
    is($v, 42, 'II get_or_set inserts default');
    my $v2 = hm_ii_get $m, 1;
    is($v2, 42, 'II get_or_set value stored');
}

# keyword get_or_set - returns existing
{
    my $m = Data::HashMap::II->new();
    hm_ii_put $m, 1, 10;
    my $v = hm_ii_get_or_set $m, 1, 99;
    is($v, 10, 'II get_or_set returns existing');
    my $v2 = hm_ii_get $m, 1;
    is($v2, 10, 'II get_or_set does not overwrite');
}

# keyword get_or_set - string/string
{
    my $m = Data::HashMap::SS->new();
    my $v = hm_ss_get_or_set $m, "k", "default";
    is($v, "default", 'SS get_or_set inserts');
    my $v2 = hm_ss_get_or_set $m, "k", "other";
    is($v2, "default", 'SS get_or_set returns existing');

t/20-new-features.t  view on Meta::CPAN

# take on expired TTL entry returns undef
{
    my $m = Data::HashMap::II->new(0, 1);
    hm_ii_put $m, 1, 42;
    sleep 2;
    is(hm_ii_take $m, 1, undef, 'II take on expired entry returns undef');
}

# I16/I32 variants
{
    my $m = Data::HashMap::I32->new();
    hm_i32_put $m, 1, 99;
    is(hm_i32_take $m, 1, 99, 'I32 take');

    my $m2 = Data::HashMap::I16->new();
    hm_i16_put $m2, 1, 42;
    is(hm_i16_take $m2, 1, 42, 'I16 take');
}

# ============================================================
# drain (batch remove + return)
# ============================================================

{
    my $m = Data::HashMap::II->new();
    hm_ii_put $m, $_, $_ * 10 for 1..10;
    my @batch = hm_ii_drain $m, 3;
    is(scalar @batch, 6, 'II drain: 3 pairs = 6 elements');
    is(hm_ii_size $m, 7, 'II drain: 7 remain');

    my @rest = hm_ii_drain $m, 100;
    is(scalar @rest, 14, 'II drain: rest = 7 pairs');
    is(hm_ii_size $m, 0, 'II drain: empty');

    my @empty = hm_ii_drain $m, 5;
    is(scalar @empty, 0, 'II drain empty map');
}

{
    my $m = Data::HashMap::SS->new();
    hm_ss_put $m, "k$_", "v$_" for 1..5;
    my @pairs = hm_ss_drain $m, 2;
    is(scalar @pairs, 4, 'SS drain: 2 pairs');
    is(hm_ss_size $m, 3, 'SS drain: 3 remain');
}

{
    my $m = Data::HashMap::IA->new();
    hm_ia_put $m, $_, [$_] for 1..3;
    my @pairs = hm_ia_drain $m, 2;
    is(scalar @pairs, 4, 'IA drain: 2 pairs');
    is(hm_ia_size $m, 1, 'IA drain: 1 remains');
    is_deeply($pairs[1], [$pairs[0]], 'IA drain: value intact');
}

# drain respects TTL
{
    my $m = Data::HashMap::II->new(0, 1);
    hm_ii_put $m, $_, $_ for 1..5;
    sleep 2;
    hm_ii_put $m, 6, 6;  # only this one is alive
    my @pairs = hm_ii_drain $m, 100;
    is(scalar @pairs, 2, 'II drain: only non-expired returned');
    is($pairs[1], 6, 'II drain: correct value');
}

# ============================================================
# pop (LRU tail / iter forward) and shift (LRU head / iter backward)
# ============================================================

# LRU pop = take from tail (least recently used)
{
    my $m = Data::HashMap::II->new(100);
    hm_ii_put $m, $_, $_ * 10 for 1..5;
    hm_ii_get $m, 3;  # promote 3 to MRU
    my ($k, $v) = hm_ii_pop $m;
    is($k, 1, 'II LRU pop: key is LRU tail');
    is($v, 10, 'II LRU pop: correct value');
    is(hm_ii_size $m, 4, 'II LRU pop: size decremented');
}

# LRU shift = take from head (most recently used)
{
    my $m = Data::HashMap::II->new(100);
    hm_ii_put $m, $_, $_ * 10 for 1..5;
    hm_ii_get $m, 2;  # promote 2 to MRU
    my ($k, $v) = hm_ii_shift $m;
    is($k, 2, 'II LRU shift: key is MRU head');
    is($v, 20, 'II LRU shift: correct value');
}

# Non-LRU pop (iter forward) exhausts map
{
    my $m = Data::HashMap::II->new();
    hm_ii_put $m, $_, $_ for 1..3;
    my @all;
    while (my @kv = hm_ii_pop $m) { push @all, @kv; }
    is(scalar @all, 6, 'II non-LRU pop: all 3 pairs consumed');
    is(hm_ii_size $m, 0, 'II non-LRU pop: map empty');
}

# Non-LRU shift (iter backward) exhausts map
{
    my $m = Data::HashMap::II->new();
    hm_ii_put $m, $_, $_ for 1..3;
    my @all;
    while (my @kv = hm_ii_shift $m) { push @all, @kv; }
    is(scalar @all, 6, 'II non-LRU shift: all 3 pairs consumed');
    is(hm_ii_size $m, 0, 'II non-LRU shift: map empty');
}

# SS pop
{
    my $m = Data::HashMap::SS->new(10);
    hm_ss_put $m, "a", "1";
    hm_ss_put $m, "b", "2";
    my ($k, $v) = hm_ss_pop $m;
    is($v, "1", 'SS LRU pop: returns LRU tail value');
}

# IA pop with SV* values