File-Flock-Retry
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
#!perl
use 5.010001;
use strict;
use warnings;
use Test::More 0.98;
use Cwd qw(abs_path);
use File::chdir;
use File::Flock::Retry;
use File::Slurper qw(write_text);
use File::Spec;
use File::Temp qw(tempdir);
plan skip_all => 'Not tested on Windows yet' if $^O =~ /win32/i;
my $dir = abs_path(tempdir(CLEANUP=>1));
$CWD = $dir;
subtest "create (unlocked)" => sub {
ok(!(-f "f1"), "f1 doesn't exist before lock");
my $lock = File::Flock::Retry->lock("f1");
ok((-f "f1"), "f1 exists after lock");
$lock->unlock;
ok(!(-f "f1"), "f1 doesn't exist after unlock");
};
subtest "create (destroyed)" => sub {
ok(!(-f "f1"), "f1 doesn't exist before lock");
my $lock = File::Flock::Retry->lock("f1");
ok((-f "f1"), "f1 exists after lock");
undef $lock;
ok(!(-f "f1"), "f1 doesn't exist after DESTROY");
};
subtest "already exists" => sub {
write_text("f1", "");
ok((-f "f1"), "f1 exists before lock");
my $lock = File::Flock::Retry->lock("f1");
ok((-f "f1"), "f1 exists after lock");
undef $lock;
ok(!(-f "f1"), "f1 created after DESTROY");
unlink "f1";
};
subtest "was created, but not empty" => sub {
ok(!(-f "f1"), "f1 doesn't exist before lock");
my $lock = File::Flock::Retry->lock("f1");
ok((-f "f1"), "f1 exists after lock");
{ open my $f1, ">>", "f1"; print $f1 "a"; close $f1 }
undef $lock;
ok((-f "f1"), "f1 still exists after DESTROY");
};
# XXX test shared lock
DONE_TESTING:
done_testing();
if (Test::More->builder->is_passing) {
diag "all tests successful, deleting test data dir";
$CWD = "/";
} else {
# don't delete test data dir if there are errors
diag "there are failing tests, not deleting test data dir $dir";
}
( run in 2.355 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )