1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
package t::Watchdog;
use strict;
use Config;
use Test::More;
my $waitfor = 360; # 30-45 seconds is normal (load affects this).
my $watchdog_pid;
my $TheEnd;
if ($Config{d_fork}) {
note "I am the main process $$, starting the watchdog process...";
$watchdog_pid = fork();
if (defined $watchdog_pid) {
if ($watchdog_pid == 0) { # We are the kid, set up the watchdog.
my $ppid = getppid();
note "I am the watchdog process $$, sleeping for $waitfor seconds...";
sleep($waitfor - 2); # Workaround for perlbug #49073
sleep(2); # Wait for parent to exit
if (kill(0, $ppid)) { # Check if parent still exists
warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
note "Terminating main process $ppid...";
kill('KILL', $ppid);
note "This is the watchdog process $$, over and out.";
}
exit(0);
} else {
note "The watchdog process $watchdog_pid launched, continuing testing...";
$TheEnd = time() + $waitfor;
}
} else {
warn "$0: fork failed: $!\n";
}
} else {
note "No watchdog process (need fork)";
}
END {
if ($watchdog_pid) { # Only in the main process.
my $left = $TheEnd - time();
note sprintf "I am the main process $$, terminating the watchdog process $watchdog_pid before it terminates me in %d seconds (testing took %d seconds).", $left, $waitfor - $left;
if (kill(0, $watchdog_pid)) {
local $? = 0;
my $kill = kill('KILL', $watchdog_pid); # We are done, the watchdog can go.
wait();
note sprintf "kill KILL $watchdog_pid = %d", $kill;
}
unlink("ktrace.out"); # Used in BSD system call tracing.
note "All done.";
}
}
1;
|
