5 use POSIX qw(EWOULDBLOCK);
9 my $EWOULDBLOCK = eval { EWOULDBLOCK() }
10 || $Fatal::_EWOULDBLOCK{$^O}
11 || plan skip_all => "EWOULDBLOCK not defined on this system";
13 my ($self_fh, $self_fh2);
17 open($self_fh, '<', $0);
18 open($self_fh2, '<', $0);
23 plan skip_all => "Cannot lock this test on this system.";
26 my $flock_return = eval { flock($self_fh, LOCK_EX | LOCK_NB); };
28 if (not $flock_return) {
29 plan skip_all => "flock on my own test not supported on this system.";
32 my $flock_return2 = flock($self_fh2, LOCK_EX | LOCK_NB);
35 plan skip_all => "this test requires locking a file twice with ".
36 "different filehandles to fail";
39 $flock_return = flock($self_fh, LOCK_UN);
41 if (not $flock_return) {
42 plan skip_all => "Odd, I can't unlock a file with flock on this system.";
45 # If we're here, then we can lock and unlock our own file.
49 ok( flock($self_fh, LOCK_EX | LOCK_NB), "Test file locked");
54 use autodie qw(flock);
55 $return = flock($self_fh2, LOCK_EX | LOCK_NB);
58 is($!+0, $EWOULDBLOCK, "Double-flocking should be EWOULDBLOCK");
59 ok(!$return, "flocking a file twice should fail");
60 is($@, "", "Non-blocking flock should not fail on EWOULDBLOCK");
64 # These are old tests which I'd love to resurrect, but they need
65 # a reliable way of getting flock to throw exceptions but with
66 # minimal blocking. They may turn into author tests.
70 flock($self_fh2, LOCK_EX | LOCK_NB);
73 ok($@, "Locking a file twice throws an exception with vanilla autodie");
74 isa_ok($@, "autodie::exception", "Exception is from autodie::exception");
76 like($@, qr/LOCK_EX/, "error message contains LOCK_EX switch");
77 like($@, qr/LOCK_NB/, "error message contains LOCK_NB switch");
78 unlike($@, qr/GLOB/ , "error doesn't include ugly GLOB mention");
82 flock(SELF, LOCK_EX | LOCK_NB);
85 ok($@, "Locking a package filehanlde twice throws exception with vanilla autodie");
86 isa_ok($@, "autodie::exception", "Exception is from autodie::exception");
88 like($@, qr/LOCK_EX/, "error message contains LOCK_EX switch");
89 like($@, qr/LOCK_NB/, "error message contains LOCK_NB switch");
90 like($@, qr/SELF/ , "error mentions actual filehandle name.");