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