1# Fork Test 2# 3# This tests the capabilities of fork after lock to 4# allow a parent to delegate the lock to its child. 5 6use strict; 7use Test; 8use File::NFSLock; 9use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); 10 11$| = 1; # Buffer must be autoflushed because of fork() below. 12plan tests => 5; 13 14my $datafile = "testfile.dat"; 15 16# Wipe lock file in case it exists 17unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); 18 19# Create a blank file 20sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); 21close (FH); 22ok (-e $datafile && !-s _); 23 24if (1) { 25 # Forced dummy scope 26 my $lock1 = new File::NFSLock { 27 file => $datafile, 28 lock_type => LOCK_EX, 29 }; 30 31 ok ($lock1); 32 33 my $pid = fork; 34 if (!defined $pid) { 35 die "fork failed!"; 36 } elsif (!$pid) { 37 # Child process 38 39 # Test possible race condition 40 # by making parent reach newpid() 41 # and attempt relock before child 42 # even calls newpid() the first time. 43 sleep 2; 44 $lock1->newpid; 45 46 # Act busy for a while 47 sleep 5; 48 49 # Now release lock 50 exit; 51 } else { 52 # Fork worked 53 ok 1; 54 # Avoid releasing lock 55 # because child should do it. 56 $lock1->newpid; 57 } 58} 59# Lock is out of scope, but 60# should still be acquired. 61 62#sysopen(FH, $datafile, O_RDWR | O_APPEND); 63#print FH "lock1\n"; 64#close FH; 65 66# Try to get a non-blocking lock. 67# Yes, it is the same process, 68# but it should have been delegated 69# to the child process. 70# This lock should fail. 71my $lock2 = new File::NFSLock { 72 file => $datafile, 73 lock_type => LOCK_EX|LOCK_NB, 74}; 75 76ok (!$lock2); 77 78# Wait for child to finish 79ok(wait); 80 81# Wipe the temporary file 82unlink $datafile; 83