xref: /openbsd-src/gnu/usr.bin/perl/dist/Time-HiRes/t/Watchdog.pm (revision eac174f2741a08d8deb8aae59a7f778ef9b5d770)

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";
                print("Terminating main process $ppid...\n");
                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();
        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.
        note ("All done.");
    }
}

1;