view release on metacpan or  search on metacpan

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

    is $a->string($b->id_of("word2")), "word2", 'cross-view id/string round-trip';
}

# ---- refuse a read-write reopen of a sealed file ----
like exception(sub { Data::Intern::Shared->new($path, 100, 4096) }),
     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::Intern::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.intern";
    { my $in = Data::Intern::Shared->new($u, 50); $in->intern("q"); }
    like exception(sub { Data::Intern::Shared->new_readonly($u) }),
         qr/not frozen/, 'new_readonly on an unsealed file croaks';
}

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

# ---- post-wrlock seal re-check: a second, already-open read-write handle on
# the same file has its OWN local readonly flag still 0 (it did not call
# freeze itself), so it can only be caught by the hdr->sealed check taken
# after the write lock is acquired -- not the h->readonly fast-path. ----
{
    my $u2 = "$dir/race.intern";
    my $w1 = Data::Intern::Shared->new($u2, 50);
    my $w2 = Data::Intern::Shared->new($u2, 50);   # second independent handle, same file
    $w1->intern("pre-freeze");
    $w1->freeze;                                    # only $w1's local readonly flag is set
    ok !$w2->readonly, 'a second handle opened earlier does not locally know it is frozen';
    like exception(sub { $w2->intern("post-freeze") }), qr/frozen|read-only/,
         'a second handle still rejects mutation via the post-wrlock sealed re-check';
    like exception(sub { $w2->clear }), qr/frozen|read-only/,
         'clear on a second handle also rejects via the post-wrlock sealed re-check';
}

# ---- freeze also works for anonymous tables (no path, nothing to msync) ----
{
    my $anon = Data::Intern::Shared->new(undef, 50);
    my $id = $anon->intern("anon-str");
    $anon->freeze;
    ok $anon->frozen,   'anonymous table can be frozen';
    ok $anon->readonly, 'freezing an anonymous handle makes it read-only';
    is $anon->string($id), "anon-str",       'anonymous frozen table still queryable (string)';
    is $anon->id_of("anon-str"), $id,        'anonymous frozen table still queryable (id_of)';
    ok $anon->exists("anon-str"),            'anonymous frozen table still queryable (exists)';
    like exception(sub { $anon->intern("more") }), qr/read-only/, 'mutating a frozen anonymous table 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;
}