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