The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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}) {
    print("# I am the main process $$, starting the watchdog process...\n");
    $watchdog_pid = fork();
    if (defined $watchdog_pid) {
	if ($watchdog_pid == 0) { # We are the kid, set up the watchdog.
	    my $ppid = getppid();
	    print("# I am the watchdog process $$, sleeping for $waitfor seconds...\n");
	    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";
		print("Terminating main process $ppid...\n");
		kill('KILL', $ppid);
		print("# This is the watchdog process $$, over and out.\n");
	    }
	    exit(0);
	} else {
	    print("# The watchdog process $watchdog_pid launched, continuing testing...\n");
	    $TheEnd = time() + $waitfor;
	}
    } else {
	warn "$0: fork failed: $!\n";
    }
} else {
    print("# No watchdog process (need fork)\n");
}

END {
    if ($watchdog_pid) { # Only in the main process.
	my $left = $TheEnd - time();
	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);
	if (kill(0, $watchdog_pid)) {
	    local $? = 0;
	    my $kill = kill('KILL', $watchdog_pid); # We are done, the watchdog can go.
	    wait();
	    printf("# kill KILL $watchdog_pid = %d\n", $kill);
	}
	unlink("ktrace.out"); # Used in BSD system call tracing.
	print("# All done.\n");
    }
}

1;