1#!/usr/bin/perl
2#
3# Check flock() feature
4#
5# This isn't a real test; it just checks to make sure we can call the method.
6# It doesn't even check to make sure that the default behavior
7# (LOCK_EX) is occurring.  This is because I don't know how to write a good
8# portable test for flocking.  I checked the Perl core distribution,
9# and found that Perl doesn't test flock either!
10
11BEGIN {
12  eval { flock STDOUT, 0 };
13  if ($@ && $@ =~ /unimplemented/) {
14    print "1..0\n";
15    exit;
16  }
17}
18
19use Fcntl ':flock';             # This works at least back to 5.004_04
20
21my $file = "tf14-$$.txt";
22my ($o, $n);
23my @a;
24
25print "1..4\n";
26
27my $N = 1;
28use Tie::File;
29print "ok $N\n"; $N++;
30
31# 2-4  Who the heck knows?
32open F, '>', $file or die $!;
33close F;
34$o = tie @a, 'Tie::File', $file, recsep => 'blah';
35print $o ? "ok $N\n" : "not ok $N\n";
36$N++;
37
38print $o->flock() ? "ok $N\n" : "not ok $N\n";
39$N++;
40
41print $o->flock(LOCK_UN) ? "ok $N\n" : "not ok $N\n";
42$N++;
43
44
45END {
46  undef $o;
47  untie @a;
48  1 while unlink $file;
49}
50
51