1
2use FindBin;
3require "$FindBin::Bin/wrap.tm";
4use File::Slurp;
5use Time::HiRes qw(sleep);
6use POSIX qw(_exit);
7use File::Flock;
8use Test::More tests => 20;
9use Test::SharedFork;
10use strict;
11use warnings;
12
13
14test_lock_held_across_fork();
15test_locks_dropped_on_sole_process_exit();
16test_locks_dropped_on_multi_process_exit();
17test_lock_rename_object();
18test_forget_locks();
19
20our $dir; # set in wrap.tt
21
22sub test_lock_held_across_fork
23{
24	my $lock1 = "$dir/lhaf1";
25	my $lock2 = "$dir/lhaf2";
26
27	if (dofork()) {
28		lock($lock1);
29		my $l = File::Flock->new($lock2);
30		write_file("$dir/gate1", "");
31
32		POSIX::_exit(0) unless dofork();
33		write_file("$dir/gate2", "");
34
35		sleep(0.1) while ! -e "$dir/gate3";
36		ok(! -e "$dir/gotlock1a", "lock held");
37		ok(! -e "$dir/gotlock1b", "obj lock held");
38		ok(! -e "$dir/gotlock2a", "child lock held");
39		ok(! -e "$dir/gotlock2b", "child obj lock held");
40		unlock($lock1);
41		write_file("$dir/gate4", "");
42
43		sleep(0.1) while ! -e "$dir/gate5";
44		ok(-e "$dir/gotlock3a", "lock released");
45		ok(! -e "$dir/gotlock3b", "obj lock not released");
46		$l->unlock();
47		write_file("$dir/gate6", "");
48
49		sleep(0.1) while ! -e "$dir/gate7";
50		ok(-e "$dir/gotlock4", "obj lock released");
51		write_file("$dir/gate8", "");
52	} else {
53		sleep(0.1) while ! -e "$dir/gate1";
54		# parent has locked lock
55		write_file("$dir/gotlock1a", "") if lock($lock1, undef, 'nonblocking');
56		write_file("$dir/gotlock1b", "") if lock($lock2, undef, 'nonblocking');
57
58		sleep(0.1) while ! -e "$dir/gate2";
59		write_file("$dir/gotlock2a", "") if lock($lock1, undef, 'nonblocking');
60		write_file("$dir/gotlock2b", "") if lock($lock2, undef, 'nonblocking');
61		write_file("$dir/gate3", "");
62
63		sleep(0.1) while ! -e "$dir/gate4";
64		write_file("$dir/gotlock3a", "") if lock($lock1, undef, 'nonblocking');
65		write_file("$dir/gotlock3b", "") if lock($lock2, undef, 'nonblocking');
66		write_file("$dir/gate5", "");
67
68		sleep(0.1) while ! -e "$dir/gate6";
69		write_file("$dir/gotlock4", "") if lock($lock2, undef, 'nonblocking');
70		write_file("$dir/gate7", "");
71		sleep(0.1) while ! -e "$dir/gate8";
72		exit(0);
73	}
74}
75
76sub test_locks_dropped_on_sole_process_exit
77{
78	my $p = "$dir/tldospe";
79
80	my $pid;
81	if (($pid = dofork())) {
82		sleep(0.1) while ! -e "$p.gate1";
83		ok(! lock("$p.lock1", undef, 'nonblocking'), "can't get lock");
84		write_file("$p.gate2", "");
85		waitpid($pid, 0);
86		ok(lock("$p.lock1", undef, 'nonblocking'), "can get lock");
87	} else {
88		lock("$p.lock1");
89		write_file("$p.gate1", "");
90
91		sleep(0.1) while ! -e "$p.gate2";
92		exit(0);
93	}
94}
95
96sub test_locks_dropped_on_multi_process_exit
97{
98	my $p = "$dir/tldompe";
99
100	my $pid;
101	if (($pid = dofork())) {
102		sleep(0.1) while ! -e "$p.gate1";
103		ok(! lock("$p.lock1", undef, 'nonblocking'), "can't get lock");
104		write_file("$p.gate2", "");
105		waitpid($pid, 0);
106		ok(lock("$p.lock1", undef, 'nonblocking'), "can get lock");
107		write_file("$p.gate3", "");
108	} else {
109		lock("$p.lock1");
110		if (dofork()) {
111			write_file("$p.gate1", "");
112
113			sleep(0.1) while ! -e "$p.gate2";
114			exit(0);
115		} else {
116			sleep(0.1) while ! -e "$p.gate3";
117			exit(0);
118		}
119
120	}
121}
122
123sub test_lock_rename_object
124{
125	my $p = "$dir/tlro";
126
127	my $l = File::Flock->new("$p.oldlock");
128	undef $!;
129	undef $@;
130	ok(eval {rename("$p.oldlock", "$p.newlock")}, "rename file - $!");
131	ok(eval {$l->lock_rename("$p.newlock")}, "rename lock - $@");
132	ok(eval {$l->unlock()}, "unlock - $@");
133}
134
135sub test_forget_locks
136{
137	my $p = "$dir/tfl";
138
139	my $pid;
140	if (($pid = dofork())) {
141		sleep(0.1) while ! -e "$p.gate1";
142		ok(! lock("$p.lock1", undef, 'nonblocking'), "can't get multi lock");
143
144		write_file("$p.gate2", "");
145		# forget locks
146		sleep(0.1) while ! -e "$p.gate4";
147		ok(! lock("$p.lock1", undef, 'nonblocking'), "still can't get multi lock");
148
149		write_file("$p.gate5", "");
150		# sub master quits
151		waitpid($pid, 0);
152		ok(kill(0, $pid) == 0, "first proc ($pid) is dead");
153		ok(! lock("$p.lock1", undef, 'nonblocking'), "and still can't get multi lock");
154
155		write_file("$p.gate3", "");
156		my $pid2 = read_file("$p.gate1");
157		sleep(0.1) while kill(0, $pid2);
158		ok(kill(0, $pid2) == 0, "second proc ($pid2) is dead");
159
160		ok(lock("$p.lock1", undef, 'nonblocking'), "now can get multi lock");
161	} else {
162		lock("$p.lock1");
163		my $subpid;
164		if (($subpid = dofork())) {
165			write_file("$p.gate1", "$subpid");
166
167			sleep(0.1) while ! -e "$p.gate2";
168			forget_locks();
169			write_file("$p.gate4", "");
170
171			sleep(0.1) while ! -e "$p.gate5";
172			exit(0);
173		} else {
174			sleep(0.1) while ! -e "$p.gate3";
175			exit(0);
176		}
177
178	}
179}
180
181
182sub dofork
183{
184	my $p = fork();
185	die unless defined $p;
186	return $p;
187}
188
189