view release on metacpan or  search on metacpan

t/10-edge-cases.t  view on Meta::CPAN

        my $child_map = Data::HashMap::Shared::II->new($path, 1000);
        # Do a normal put to prove the child can access the map
        shm_ii_put $child_map, 2, 99;
        POSIX::_exit(0);
    }
    waitpid($pid, 0);

    # Now manually corrupt the lock to simulate the child dying while holding it.
    # The header is at the start of the mmap file. rwlock is at offset 128
    # and encodes 0x80000000 | pid when write-locked. seq is at offset 64.
    open my $fh, '+<:raw', $path or die "Cannot open $path: $!";
    # Set rwlock = 0x80000000 | $pid (write-locked by dead child)
    seek($fh, 128, 0);
    print $fh pack('V', 0x80000000 | $pid);
    # Set seq to odd (writer active)
    seek($fh, 64, 0);
    print $fh pack('V', 1);
    close $fh;

    # Re-open the map — the stale lock is now in the mmap
    undef $map;
    $map = Data::HashMap::Shared::II->new($path, 1000);

    # This should recover after SHM_LOCK_TIMEOUT_SEC (2s) since $pid is dead
    my $val = shm_ii_get $map, 1;
    # The data written before corruption should still be readable
    is($val, 42, 'recovered from stale lock without deadlock');
    ok(shm_ii_stat_recoveries($map) > 0, 'stat_recoveries incremented after recovery');

    unlink $path;
}

# error diagnostics: wrong variant gives informative message
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 100);
    shm_ii_put $map, 1, 1;
    undef $map;

    eval { Data::HashMap::Shared::SS->new($path, 100) };
    like($@, qr/variant mismatch/, 'variant mismatch gives diagnostic error');
    like($@, qr/file=\d+, expected=\d+/, 'error includes variant IDs');

    unlink $path;
}

# error diagnostics: bad path gives errno message
{
    eval { Data::HashMap::Shared::II->new('/nonexistent/path/test.shm', 100) };
    like($@, qr/No such file|Permission denied/, 'bad path gives errno in error');
}

# unlink: instance method
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 100);
    shm_ii_put $map, 1, 42;
    ok(-f $path, 'backing file exists');
    ok($map->unlink, 'instance unlink returns true');
    ok(!-f $path, 'backing file removed after unlink');
    # map still works (mmap stays alive after unlink)
    my $v = shm_ii_get $map, 1;
    is($v, 42, 'map still readable after unlink');
}

# unlink: class method
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 100);
    undef $map;
    ok(-f $path, 'backing file exists before class unlink');
    ok(Data::HashMap::Shared::II->unlink($path), 'class unlink returns true');
    ok(!-f $path, 'backing file removed after class unlink');
}

# unlink: returns false for non-existent file
{
    ok(!Data::HashMap::Shared::II->unlink('/tmp/nonexistent_shm_test_' . $$ . '.shm'),
       'unlink returns false for non-existent file');
}

# lru_skip: probabilistic promotion skip reduces churn
{
    my $path = tmpfile();
    # max_size=100, ttl=0, lru_skip=90 (skip 90% of promotions)
    my $map = Data::HashMap::Shared::II->new($path, 10000, 100, 0, 90);

    # fill to capacity
    shm_ii_put $map, $_, $_ for 1..100;

    # repeatedly access a non-tail key — with 90% skip, most promotes are skipped
    # but the entry should still be reachable and not evicted
    shm_ii_get $map, 50 for 1..20;
    my $v = shm_ii_get $map, 50;
    is($v, 50, 'lru_skip: frequently accessed key still readable');

    # insert more entries to trigger evictions
    shm_ii_put $map, 100 + $_, 100 + $_ for 1..50;
    is(shm_ii_size $map, 100, 'lru_skip: map stays at max_size');
    ok(shm_ii_stat_evictions($map) >= 50, 'lru_skip: evictions occurred');

    # tail entry (LRU victim) is never skip-protected — eviction still works
    # the map should be functional and not corrupt
    my $count = 0;
    while (my ($k, $v) = shm_ii_each $map) { $count++ }
    is($count, 100, 'lru_skip: iteration returns exactly max_size entries');

    unlink $path;
}

# lru_skip=0 (default): strict LRU, same as before
{
    my $path = tmpfile();
    my $map = Data::HashMap::Shared::II->new($path, 10000, 5, 0, 0);

    shm_ii_put $map, $_, $_ for 1..5;
    # access key 1 to promote it
    shm_ii_get $map, 1;
    # insert one more — should evict key 2 (LRU), not key 1 (promoted)
    shm_ii_put $map, 6, 6;
    my $v2 = shm_ii_get $map, 2;