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