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
11use strict;
12use warnings;
13
14BEGIN {
15  eval { flock STDOUT, 0 };
16  if ($@ && $@ =~ /unimplemented/) {
17    print "1..0\n";
18    exit;
19  }
20}
21
22use Fcntl ':flock';             # This works at least back to 5.004_04
23
24my $file = "tf14-$$.txt";
25my ($o, $n);
26my @a;
27
28print "1..4\n";
29
30my $N = 1;
31use Tie::File;
32print "ok $N\n"; $N++;
33
34# 2-4  Who the heck knows?
35open F, '>', $file or die $!;
36close F;
37$o = tie @a, 'Tie::File', $file, recsep => 'blah';
38print $o ? "ok $N\n" : "not ok $N\n";
39$N++;
40
41print $o->flock() ? "ok $N\n" : "not ok $N\n";
42$N++;
43
44print $o->flock(LOCK_UN) ? "ok $N\n" : "not ok $N\n";
45$N++;
46
47
48END {
49  undef $o;
50  untie @a;
51  1 while unlink $file;
52}
53
54