lib/Tie/File/t/14_lock.t

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