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 = "tf$$.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