[RFC] common test code for timed bail out

Front page | perl.perl5.porters | Postings from June 2008

[RFC] common test code for timed bail out

Thread Next

From:

Jerry D. Hedden

Date:

June 26, 2008 08:31

Subject:

[RFC] common test code for timed bail out

Message ID:

1ff86f510806260831m2a13fd0me968abd8f8b7b4c8@mail.gmail.com

The attached patch contains my proposal for addressing the
following Perl TODO:

=head2 common test code for timed bail out

Write portable self destruct code for tests to stop them burning CPU in
infinite loops. This needs to avoid using alarm, as some of the tests are
testing alarm/sleep or timers.

Here's the code to be added to test.pl:

# Forks a child process that kills the parent if the timeout is reached
sub timeout ($)
{
    my $timeout = shift;

    my $child_pid;
    eval { $child_pid = fork() };
    return if (! defined($child_pid));   # Fork failed

    # Child process
    if ($child_pid == 0) {
        my $ppid = getppid();
        exit(0) if (! $ppid);   # Failed getting parent PID

        sleep($timeout - 2) if ($timeout > 2);   # Workaround for perlbug #49073
        sleep(2);

        # Kill parent if it still exists
        if (kill(0, $ppid)) {
            _diag("Test process (PID=$$) timed out");
            kill('KILL', $ppid);
        }
        exit(0);
    }

    # Add END block to parent to clean up child process
    eval "END { kill('KILL', $child_pid) if (kill(0, $child_pid)); }";
}

Also, please comment on which core test files should be
patched to use this (if and when it is incorporated).

Thread Next