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