Skip to content

Commit 3533239

Browse files
committed
test.pl: Calling watchdog cancels existing ones
This enhances the code to work on cases like: watchdog(5); sleep 4; watchdog(10); sleep 8; Prior to this commit, you had to explicitly cancel an existing watchdog before setting a new one. As a result of this commit, all possible wathdog variables get undef'd early. This makes later undef calls redundant, so they are removed. Suggested by Tony Cook
1 parent dcdb676 commit 3533239

File tree

2 files changed

+7
-13
lines changed

2 files changed

+7
-13
lines changed

t/test.pl

Lines changed: 5 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1844,9 +1844,9 @@ ($;$)
18441844
{
18451845
my $timeout = shift;
18461846

1847-
# If cancelling, use the state variables to know which method was used to
1848-
# create the watchdog.
1849-
if ($timeout == 0) {
1847+
# Cancel any existing timer, so the caller can set multiple ones without
1848+
# cancelling first. For safety, handle the case where somehow more than
1849+
# one type of watchdog got set.
18501850
if ($watchdog_thread) {
18511851
$watchdog_thread->kill('KILL');
18521852
undef $watchdog_thread;
@@ -1860,12 +1860,8 @@ ($;$)
18601860
undef $watchdog_alarm;
18611861
}
18621862

1863-
return;
1864-
}
1865-
1866-
# Make sure these aren't defined.
1867-
undef $watchdog_process;
1868-
undef $watchdog_thread;
1863+
# We are done if this call was just to cancel
1864+
return if $timeout == 0;
18691865

18701866
my $method = shift || "";
18711867

@@ -1915,7 +1911,6 @@ ($;$)
19151911
return if ($pid_to_kill <= 0);
19161912

19171913
# Launch watchdog process
1918-
undef $watchdog_process;
19191914
eval {
19201915
local $SIG{'__WARN__'} = sub {
19211916
_diag("Watchdog warning: $_[0]");
@@ -1966,7 +1961,6 @@ ($;$)
19661961
}
19671962

19681963
# Try using fork() to generate a watchdog process
1969-
undef $watchdog_process;
19701964
eval { $watchdog_process = fork() };
19711965
if (defined($watchdog_process)) {
19721966
if ($watchdog_process) { # Parent process

t/test_pl.pod

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -489,8 +489,8 @@ Note: currently only used by F<test.pl> itself.
489489

490490
=item watchdog($timeout, $method);
491491

492-
Start a watchdog timer for C<$timeout> seconds. If C<$timeout> is
493-
zero then disables any existing watchdog timer.
492+
Start a watchdog timer for C<$timeout> seconds, while disabling any
493+
existing one. If C<$timeout> is zero no new timer is created.
494494

495495
The timeout may be scaled by setting C<PERL_TEST_TIME_OUT_FACTOR> or
496496
C<PERL_TEST_TIMEOUT_FACTOR> in the environment. If C<PERL_VALGRIND>

0 commit comments

Comments
 (0)