1# Lock Test with fatal error (die) 2 3use strict; 4use warnings; 5 6use Test::More tests => 9; 7use File::NFSLock; 8use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); 9 10$| = 1; # Buffer must be autoflushed because of fork() below. 11 12my $datafile = "testfile.dat"; 13 14# Wipe lock file in case it exists 15unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); 16 17# Create a blank file 18sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); 19close ($fh); 20# test 1 21ok (-e $datafile && !-s _); 22 23 24# test 2 25my ($rd1, $wr1); 26ok (pipe($rd1, $wr1)); # Connected pipe for child1 27 28my $pid = fork; 29if (!$pid) { 30 # Child #1 process 31 # Obtain exclusive lock 32 my $lock = new File::NFSLock { 33 file => $datafile, 34 lock_type => LOCK_EX, 35 }; 36 print $wr1 !!$lock; # Send boolean success status down pipe 37 close($wr1); # Signal to parent that the Blocking lock is done 38 close($wr1); 39 if ($lock) { 40 sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); 41 # And then put a magic word into the file 42 print $fh "exclusive\n"; 43 close $fh; 44 open(STDERR,">/dev/null"); 45 die "I will die while lock is still aquired"; 46 } 47 die "Lock failed!"; 48} 49 50# test 3 51ok 1; # Fork successful 52close ($wr1); 53# Waiting for child1 to finish its lock status 54my $child1_lock = <$rd1>; 55close ($rd1); 56# Report status of the child1_lock. 57# It should have been successful 58# test 4 59ok ($child1_lock); 60 61# Clear the zombie 62# test 5 63ok (wait); 64 65# test 6 66my ($rd2, $wr2); 67ok (pipe($rd2, $wr2)); # Connected pipe for child2 68if (!fork) { 69 # The last lock died, so this should aquire fine. 70 my $lock = new File::NFSLock { 71 file => $datafile, 72 lock_type => LOCK_EX, 73 blocking_timeout => 10, 74 }; 75 if ($lock) { 76 sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); 77 # Immediately put the magic word into the file 78 print $fh "lock2\n"; 79 truncate ($fh, tell $fh); 80 close $fh; 81 } 82 print $wr2 !!$lock; # Send boolean success status down pipe 83 close($wr2); # Signal to parent that the Blocking lock is done 84 close($rd2); 85 exit; # Release this new lock 86} 87# test 7 88ok 1; # Fork successful 89close ($wr2); 90 91# Waiting for child2 to finish its lock status 92my $child2_lock = <$rd2>; 93close ($rd2); 94# Report status of the child2_lock. 95# This should have been successful. 96# test 8 97ok ($child2_lock); 98 99# Load up whatever the file says now 100sysopen(my $fh2, $datafile, O_RDONLY); 101 102$_ = <$fh2>; 103# test 9 104ok /lock2/; 105close $fh2; 106 107# Wipe the temporary file 108unlink $datafile; 109