Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
00-load.t	127 B	-r--r--r--	2014-12-27 11:48
Fatal.t	950 B	-r--r--r--	2014-12-27 11:48
args.t	1.32 KB	-r--r--r--	2014-12-27 11:48
autodie.t	2.51 KB	-r--r--r--	2014-12-27 11:48
autodie_skippy.pm	363 B	-r--r--r--	2014-12-27 11:48
autodie_test_module.pm	879 B	-r--r--r--	2014-12-27 11:48
backcompat.t	584 B	-r--r--r--	2014-12-27 11:48
basic_exceptions.t	1.4 KB	-r--r--r--	2014-12-27 11:48
binmode.t	682 B	-r--r--r--	2014-12-27 11:48
blog_hints.t	707 B	-r--r--r--	2014-12-27 11:48
caller.t	743 B	-r--r--r--	2014-12-27 11:48
chmod.t	529 B	-rwxr-xr-x	2014-12-27 11:48
chown.t	764 B	-r--r--r--	2014-12-27 11:48
context.t	1.31 KB	-r--r--r--	2014-12-27 11:48
context_lexical.t	1.61 KB	-r--r--r--	2014-12-27 11:48
core-trampoline-slurp.t	650 B	-r--r--r--	2014-12-27 11:48
crickey.t	667 B	-r--r--r--	2014-12-27 11:48
dbmopen.t	826 B	-r--r--r--	2014-12-27 11:48
eval_error.t	547 B	-r--r--r--	2014-12-27 11:48
exception_class.t	1.35 KB	-r--r--r--	2014-12-27 11:48
exceptions.t	1.27 KB	-r--r--r--	2014-12-27 11:48
exec.t	324 B	-r--r--r--	2014-12-27 11:48
filehandles.t	1.08 KB	-r--r--r--	2014-12-27 11:48
fileno.t	740 B	-r--r--r--	2014-12-27 11:48
flock.t	2.69 KB	-r--r--r--	2014-12-27 11:48
format-clobber.t	1.98 KB	-r--r--r--	2014-12-27 11:48
hints.t	3.86 KB	-r--r--r--	2014-12-27 11:48
hints_insist.t	643 B	-r--r--r--	2014-12-27 11:48
hints_pod_examples.t	5.29 KB	-r--r--r--	2014-12-27 11:48
hints_provider_does.t	543 B	-r--r--r--	2014-12-27 11:48
hints_provider_easy_does_it.t	551 B	-r--r--r--	2014-12-27 11:48
hints_provider_isa.t	542 B	-r--r--r--	2014-12-27 11:48
internal-backcompat.t	2.8 KB	-r--r--r--	2014-12-27 11:48
internal.t	866 B	-r--r--r--	2014-12-27 11:48
kill.t	650 B	-r--r--r--	2014-12-27 11:48
lethal.t	466 B	-r--r--r--	2014-12-27 11:48
mkdir.t	1.81 KB	-r--r--r--	2014-12-27 11:48
no_carp.t	195 B	-r--r--r--	2014-12-27 11:48
open.t	2.53 KB	-r--r--r--	2014-12-27 11:48
recv.t	1.53 KB	-r--r--r--	2014-12-27 11:48
repeat.t	382 B	-r--r--r--	2014-12-27 11:48
rt-74246.t	301 B	-r--r--r--	2014-12-27 11:48
scope_leak.t	2.33 KB	-r--r--r--	2014-12-27 11:49
skip.t	631 B	-r--r--r--	2014-12-27 11:48
string-eval-basic.t	624 B	-r--r--r--	2014-12-27 11:48
string-eval-leak.t	820 B	-r--r--r--	2014-12-27 11:48
sysopen.t	450 B	-r--r--r--	2014-12-27 11:48
touch_me	57 B	-r--r--r--	2014-12-27 11:48
truncate.t	3.35 KB	-r--r--r--	2014-12-27 11:49
truncate_me	0 B	-rw-r--r--	2016-10-10 18:14
unlink.t	1.64 KB	-r--r--r--	2014-12-27 11:48
user-context.t	1.27 KB	-r--r--r--	2014-12-27 11:48
usersub.t	1.28 KB	-r--r--r--	2014-12-27 11:48
utf8_open.t	3.04 KB	-r--r--r--	2014-12-27 11:48
utime.t	840 B	-r--r--r--	2014-12-27 11:48
version.t	626 B	-r--r--r--	2014-12-27 11:48
version_tag.t	2.06 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl -w
use strict;
use Test::More;
use Fcntl qw(:flock);
use POSIX qw(EWOULDBLOCK EAGAIN);
use Config;

require Fatal;

my $EWOULDBLOCK = eval { EWOULDBLOCK() }
                  || $Fatal::_EWOULDBLOCK{$^O}
                  || plan skip_all => "EWOULDBLOCK not defined on this system";

my $try_EAGAIN = ($^O eq 'linux' and $Config{archname} =~ /hppa|parisc/) ? 1 : 0;
my $EAGAIN = eval { EAGAIN() };

my ($self_fh, $self_fh2);

eval {
    use autodie;
    open($self_fh,  '<', $0);
    open($self_fh2, '<', $0);
    open(SELF,      '<', $0);
};

if ($@) {
    plan skip_all => "Cannot lock this test on this system.";
}

my $flock_return = eval { flock($self_fh, LOCK_EX | LOCK_NB); };

if (not $flock_return) {
    plan skip_all => "flock on my own test not supported on this system.";
}

my $flock_return2 = flock($self_fh2, LOCK_EX | LOCK_NB);

if ($flock_return2) {
    plan skip_all => "this test requires locking a file twice with ".
                     "different filehandles to fail";
}

$flock_return = flock($self_fh, LOCK_UN);

if (not $flock_return) {
    plan skip_all => "Odd, I can't unlock a file with flock on this system.";
}

# If we're here, then we can lock and unlock our own file.

plan 'no_plan';

ok( flock($self_fh, LOCK_EX | LOCK_NB), "Test file locked");

my $return;

eval {
    use autodie qw(flock);
    $return = flock($self_fh2, LOCK_EX | LOCK_NB);
};

if (!$try_EAGAIN) {
    is($!+0, $EWOULDBLOCK, "Double-flocking should be EWOULDBLOCK");
} else {
    ok($!+0 == $EWOULDBLOCK || $!+0 == $EAGAIN, "Double-flocking should be EWOULDBLOCK or EAGAIN");
}
ok(!$return, "flocking a file twice should fail");
is($@, "", "Non-blocking flock should not fail on EWOULDBLOCK");

__END__

# These are old tests which I'd love to resurrect, but they need
# a reliable way of getting flock to throw exceptions but with
# minimal blocking.  They may turn into author tests.

eval {
    use autodie;
    flock($self_fh2, LOCK_EX | LOCK_NB);
};

ok($@, "Locking a file twice throws an exception with vanilla autodie");
isa_ok($@, "autodie::exception", "Exception is from autodie::exception");

like($@,   qr/LOCK_EX/, "error message contains LOCK_EX switch");
like($@,   qr/LOCK_NB/, "error message contains LOCK_NB switch");
unlike($@, qr/GLOB/   , "error doesn't include ugly GLOB mention");

eval {
    use autodie;
    flock(SELF, LOCK_EX | LOCK_NB);
};

ok($@, "Locking a package filehanlde twice throws exception with vanilla autodie");
isa_ok($@, "autodie::exception", "Exception is from autodie::exception");

like($@,   qr/LOCK_EX/, "error message contains LOCK_EX switch");
like($@,   qr/LOCK_NB/, "error message contains LOCK_NB switch");
like($@,   qr/SELF/   , "error mentions actual filehandle name.");