mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
a7f3f23c84
If you set a watchdog timer, you should clear it when its no longer needed. Otherwise it can go off, aborting your test script. In these twenty test files, it hasn't mostly been a problem because the script finishes before the timer goes off. But I bet that some heisenbugs have been the result of not clearing it. It actually shouldn't be necessary to clear the timer when that is the final statement in the test file, but we may want to add a porting test that makes sure watchdogs are cleared, and always adding a clear enables such a test to properly work.
47 lines
1.2 KiB
Perl
47 lines
1.2 KiB
Perl
#!./perl
|
|
|
|
BEGIN {
|
|
chdir 't' if -d 't';
|
|
require "./test.pl";
|
|
set_up_inc('../lib');
|
|
}
|
|
|
|
plan tests => 3;
|
|
watchdog(10, $^O eq 'MSWin32' ? "alarm" : '');
|
|
|
|
use Config;
|
|
$| = 1;
|
|
$SIG{PIPE} = 'IGNORE';
|
|
# work around a shell set to ignore HUP
|
|
$SIG{HUP} = 'DEFAULT';
|
|
$SIG{HUP} = 'IGNORE' if $^O eq 'interix';
|
|
|
|
my $perl = which_perl();
|
|
|
|
my $killsig = 'HUP';
|
|
$killsig = 1 unless $Config{sig_name} =~ /\bHUP\b/;
|
|
|
|
SKIP:
|
|
{
|
|
skip("Not relevant to $^O", 3)
|
|
if $^O eq "MSWin32" || $^O eq "VMS";
|
|
skip("only matters for waitpid or wait4", 3)
|
|
unless $Config{d_waitpid} || $Config{d_wait4};
|
|
# [perl #119893]
|
|
# close on the original of a popen handle dupped to a standard handle
|
|
# would wait4pid(0, ...)
|
|
open my $savein, "<&", \*STDIN;
|
|
my $pid = open my $fh1, "-|", $perl, "-e", "sleep 50";
|
|
ok($pid, "open a pipe");
|
|
# at this point PL_fdpids[fileno($fh1)] is the pid of the new process
|
|
ok(open(STDIN, "<&=", $fh1), "dup the pipe");
|
|
# now PL_fdpids[fileno($fh1)] is zero and PL_fdpids[0] is
|
|
# the pid of the process created above, previously this would block
|
|
# internally on waitpid(0, ...)
|
|
ok(close($fh1), "close the original");
|
|
kill $killsig, $pid;
|
|
open STDIN, "<&", $savein;
|
|
}
|
|
|
|
watchdog(0);
|