view release on metacpan or  search on metacpan

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

    ok eval { $ro->sync; 1 }, 'sync is a silent no-op on a read-only handle'
        or diag $@;

    like exception(sub { $ro->set(1) }),    qr/read-only/, 'set on read-only view croaks';
    like exception(sub { $ro->clear(10) }), qr/read-only/, 'clear on read-only view croaks';
    like exception(sub { $ro->toggle(1) }), qr/read-only/, 'toggle on read-only view croaks';
    like exception(sub { $ro->fill }),      qr/read-only/, 'fill on read-only view croaks';
    like exception(sub { $ro->zero }),      qr/read-only/, 'zero on read-only view croaks';
    like exception(sub { $ro->freeze }),    qr/read-only/, 'freeze on read-only view croaks';

    # the read-only handle's bits are untouched by the rejected mutators
    is $ro->count, $exp_count, 'count still unchanged after rejected mutators on read-only view';
}

# ---- two independent read-only views of the same file, concurrently ----
{
    my $a = Data::BitSet::Shared->new_readonly($path);
    my $b = Data::BitSet::Shared->new_readonly($path);
    ok $a->test(10) && $b->test(10), 'two read-only views query the same file';
}

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

# ---- new_from_fd also refuses a sealed file ----
{
    open my $fh, '+<', $path or die "open $path: $!";
    like exception(sub { Data::BitSet::Shared->new_from_fd(fileno($fh)) }),
         qr/frozen|read-only/, 'new_from_fd on a sealed file is refused';
}

# ---- new_readonly rejects a non-frozen file ----
{
    my $u = "$dir/unsealed.bs";
    { my $bs = Data::BitSet::Shared->new($u, 64); $bs->set(1); }
    like exception(sub { Data::BitSet::Shared->new_readonly($u) }),
         qr/not frozen/, 'new_readonly on an unsealed file croaks';
}

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

# ---- freeze also works for anonymous bitsets (no path, nothing to msync) ----
{
    my $anon = Data::BitSet::Shared->new(undef, 64);
    $anon->set(5);
    $anon->freeze;
    ok $anon->frozen,   'anonymous bitset can be frozen';
    ok $anon->readonly, 'freezing an anonymous handle makes it read-only';
    is $anon->test(5), 1, 'anonymous frozen bitset still queryable';
    like exception(sub { $anon->set(6) }), qr/read-only/, 'mutating a frozen anonymous bitset croaks';
}

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;
}