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