view release on metacpan or  search on metacpan

t/04-lru-ttl.t  view on Meta::CPAN

    my $map = Data::HashMap::Shared::II->new($path, 1000, 10);

    is(shm_ii_incr $map, 1, 1, 'incr with LRU');
    is(shm_ii_incr $map, 1, 2, 'incr again');
    is(shm_ii_decr $map, 1, 1, 'decr with LRU');
    is(shm_ii_incr_by $map, 1, 100, 101, 'incr_by with LRU');

    unlink $path;
}

# Method API for LRU/TTL
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 1000, 5, 10);
    is($map->max_size(), 5, 'method max_size');
    is($map->ttl(), 10, 'method ttl');
    $map->put_ttl(1, 100, 60);
    is($map->get(1), 100, 'method put_ttl + get');

    unlink $path;
}

# Cross-process LRU
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 1000, 3);

    shm_ii_put $map, 1, 10;
    shm_ii_put $map, 2, 20;
    shm_ii_put $map, 3, 30;

    my $pid = fork();
    if ($pid == 0) {
        my $child = Data::HashMap::Shared::II->new($path, 1000, 3);
        shm_ii_put $child, 4, 40;  # should evict key=1
        POSIX::_exit(0);
    }
    waitpid($pid, 0);

    ok(!defined(shm_ii_get $map, 1), 'cross-process LRU eviction');
    is(shm_ii_get $map, 4, 40, 'cross-process new entry');

    unlink $path;
}

# keys/values/items/each skip expired entries
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 1000, 0, 2);

    shm_ii_put $map, 1, 10;
    shm_ii_put_ttl $map, 2, 20, 100;  # long TTL

    sleep 4;

    my @k = shm_ii_keys $map;
    # key 1 should be expired during iteration, key 2 should survive
    # Note: keys iteration may or may not lazily expire
    # But get should definitely expire
    ok(!defined(shm_ii_get $map, 1), 'key 1 expired');
    is(shm_ii_get $map, 2, 20, 'key 2 still alive');

    unlink $path;
}

# clear resets LRU state
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 1000, 3);

    shm_ii_put $map, 1, 10;
    shm_ii_put $map, 2, 20;
    shm_ii_clear $map;
    is(shm_ii_size $map, 0, 'cleared');

    # Should be able to insert 3 more after clear
    shm_ii_put $map, 10, 100;
    shm_ii_put $map, 20, 200;
    shm_ii_put $map, 30, 300;
    is(shm_ii_size $map, 3, '3 after clear');

    # 4th should evict
    shm_ii_put $map, 40, 400;
    is(shm_ii_size $map, 3, 'LRU still works after clear');

    unlink $path;
}

# Reopen existing LRU/TTL map
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 1000, 3, 3600);
    shm_ii_put $map, 1, 10;
    shm_ii_put $map, 2, 20;
    undef $map;

    my $map2 = Data::HashMap::Shared::II->new($path, 1000, 3, 3600);
    is(shm_ii_get $map2, 1, 10, 'reopen: key 1 survives');
    is(shm_ii_get $map2, 2, 20, 'reopen: key 2 survives');
    is(shm_ii_max_size $map2, 3, 'reopen: max_size preserved');
    is(shm_ii_ttl $map2, 3600, 'reopen: ttl preserved');

    # LRU still works after reopen (clock eviction — size stays at max)
    shm_ii_put $map2, 3, 30;
    shm_ii_put $map2, 4, 40;  # triggers eviction
    my $sz = shm_ii_size $map2;
    ok($sz <= 3, 'reopen: LRU eviction keeps size at max_size');
    is(shm_ii_get $map2, 4, 40, 'reopen: new entry present');

    unlink $path;
}

# Remove with LRU (correct unlink from LRU chain)
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 1000, 5);

    shm_ii_put $map, 1, 10;
    shm_ii_put $map, 2, 20;
    shm_ii_put $map, 3, 30;