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