view release on metacpan or  search on metacpan

t/02-frozen.t  view on Meta::CPAN

    is $st->{frozen},   1,     'stats.frozen set';
    is $st->{readonly}, 1,     'stats.readonly set';
    is $st->{dirty},    0,     'stats.dirty is 0 read-only';
    is $st->{count},    $N,    'stats.count read-only';
    is $st->{capacity}, 1000,  'stats.capacity read-only';
    is $st->{dims},     $DIMS, 'stats.dims read-only';

    is $ro->path, $path, 'path readable read-only';
    is $ro->memfd, -1, 'memfd readable read-only (file-backed => -1)';
    eval { $ro->sync };
    ok !$@, 'sync on read-only view is a silent no-op';

    like exception(sub { $ro->add([1, 2, 3]) }), qr/read-only/, 'add on read-only view croaks';
    like exception(sub { $ro->build }),          qr/read-only/, 'build on read-only view croaks';
    like exception(sub { $ro->clear }),          qr/read-only/, 'clear on read-only view croaks';
    like exception(sub { $ro->freeze }),         qr/read-only/, 'freeze on read-only view croaks';
}

# ---- two independent read-only views of the same file, concurrently ----
{
    my $a = Data::KDTree::Shared->new_readonly($path);
    my $b = Data::KDTree::Shared->new_readonly($path);
    my $na = $a->nearest([123, 456, 789]);
    my $nb = $b->nearest([123, 456, 789]);
    ok defined($na->{id}), 'two read-only views query the same file';
    is $na->{id}, $nb->{id}, 'both views see identical nearest';
}

# ---- refuse a read-write reopen of a sealed file ----
like exception(sub { Data::KDTree::Shared->new($path, $DIMS, 1000) }),
     qr/frozen|read-only/, 'read-write reopen of a sealed file is refused';

# ---- new_readonly rejects a non-frozen file ----
{
    my $u = "$dir/unsealed.kd";
    { my $kd = Data::KDTree::Shared->new($u, 2, 100); $kd->add([1, 2], 1); }
    like exception(sub { Data::KDTree::Shared->new_readonly($u) }),
         qr/not frozen/, 'new_readonly on an unsealed file croaks';
}

# ---- new_readonly error paths ----
like exception(sub { Data::KDTree::Shared->new_readonly("$dir/does-not-exist.kd") }),
     qr/open|No such/, 'new_readonly on a missing path croaks';
like exception(sub { Data::KDTree::Shared->new_readonly(undef) }),
     qr/required/, 'new_readonly requires a path';

# ---- a frozen EMPTY tree is valid and queryable read-only ----
{
    my $ep = "$dir/empty.kd";
    { my $kd = Data::KDTree::Shared->new($ep, 2, 10); $kd->freeze; }
    my $ro = Data::KDTree::Shared->new_readonly($ep);
    is $ro->count, 0, 'frozen empty tree: count 0 read-only';
    ok !defined($ro->nearest([0, 0])), 'frozen empty tree: nearest undef read-only';
    is_deeply [$ro->knn([0, 0], 3)],       [], 'frozen empty tree: knn empty read-only';
    is_deeply [$ro->range([0, 0], [9, 9])], [], 'frozen empty tree: range empty read-only';
    is_deeply [$ro->radius([0, 0], 5)],     [], 'frozen empty tree: radius empty read-only';
}

done_testing;

# minimal exception helper (avoid a Test::Fatal dependency)
sub exception {
    my $code = shift;
    my $err;
    { local $@; eval { $code->(); 1 } or $err = $@; }
    return $err;
}