Skip to content

Commit 79a2662

Browse files
committed
test.pl: Use END blocks to cancel watchdog timers
In doing follow up work to a7f3f23 "Turn off watchdog when done in tests", I realized that my solution was suboptimal, and that the code already existed in test.pl to do things better. What that code does is to create an END block to cancel the watchdog upon program exit. I think that is a better solution than to force the addition of explicit calls to watchdog(0). This commit creates a standard way to specify the code that does the cancellation, and to use it, not only when the END block does, but also when the timer is explicitly cancelled. That standard method is to create a string that basically gets evaled. This entailed making any watchdog thread object into a global so that a reference to it could be stringified for the eval. This means the calls to watchdog(0) that occur at the end of the file that were added in a7f3f23 aren't necessary. The END block takes care of it. The reason to keep them would be if we want to add a porting test that every watchdog is cleared.
1 parent 3e69d0f commit 79a2662

File tree

1 file changed

+27
-35
lines changed

1 file changed

+27
-35
lines changed

t/test.pl

Lines changed: 27 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1834,8 +1834,7 @@ sub warning_like {
18341834
# NOTE: If the test file uses 'threads', then call the watchdog() function
18351835
# _AFTER_ the 'threads' module is loaded.
18361836
{ # Closure
1837-
my $watchdog;
1838-
my $watchdog_thread;
1837+
my $cancel_string;
18391838

18401839
sub watchdog ($;$)
18411840
{
@@ -1844,29 +1843,18 @@ ($;$)
18441843
# If cancelling, use the state variables to know which method was used to
18451844
# create the watchdog.
18461845
if ($timeout == 0) {
1847-
if ($watchdog_thread) {
1848-
$watchdog_thread->kill('KILL');
1849-
undef $watchdog_thread;
1850-
}
1851-
elsif ($watchdog) {
1852-
kill('KILL', $watchdog);
1853-
undef $watchdog;
1854-
}
1855-
else {
1856-
alarm(0);
1857-
}
1858-
1846+
eval $cancel_string if defined $cancel_string;
18591847
return;
18601848
}
18611849

1862-
# Make sure these aren't defined.
1863-
undef $watchdog;
1864-
undef $watchdog_thread;
1865-
18661850
my $method = shift || "";
18671851

18681852
my $timeout_msg = 'Test process timed out - terminating';
18691853

1854+
# Common to all cancellation types; HERE gets replaced by the individual
1855+
# code
1856+
$cancel_string = 'local $! = 0; local $? = 0; HERE; undef $cancel_string';
1857+
18701858
# Accept either spelling
18711859
my $timeout_factor = $ENV{PERL_TEST_TIME_OUT_FACTOR}
18721860
|| $ENV{PERL_TEST_TIMEOUT_FACTOR}
@@ -1888,9 +1876,9 @@ ($;$)
18881876
# shut up use only once warning
18891877
my $threads_on = $threads::threads && $threads::threads;
18901878

1891-
# Don't use a watchdog process if 'threads' is loaded -
1892-
# use a watchdog thread instead
1879+
# Use a watchdog process unless 'threads' is loaded
18931880
if (!$threads_on || $method eq "process") {
1881+
my $watchdog;
18941882

18951883
# On Windows and VMS, try launching a watchdog process
18961884
# using system(1, ...) (see perlport.pod). system() returns
@@ -1909,7 +1897,6 @@ ($;$)
19091897
return if ($pid_to_kill <= 0);
19101898

19111899
# Launch watchdog process
1912-
undef $watchdog;
19131900
eval {
19141901
local $SIG{'__WARN__'} = sub {
19151902
_diag("Watchdog warning: $_[0]");
@@ -1950,22 +1937,21 @@ ($;$)
19501937
return;
19511938
}
19521939

1953-
# Add END block to parent to terminate and
1954-
# clean up watchdog process
1955-
eval("END { local \$! = 0; local \$? = 0;
1956-
wait() if kill('KILL', $watchdog); };");
1940+
# Add END block to parent to terminate and clean up watchdog
1941+
# process
1942+
$cancel_string =~ s/HERE/wait() if kill('KILL', $watchdog)/;
1943+
eval("END { $cancel_string };");
19571944
return;
19581945
}
19591946

19601947
# Try using fork() to generate a watchdog process
1961-
undef $watchdog;
19621948
eval { $watchdog = fork() };
19631949
if (defined($watchdog)) {
19641950
if ($watchdog) { # Parent process
1965-
# Add END block to parent to terminate and
1966-
# clean up watchdog process
1967-
eval "END { local \$! = 0; local \$? = 0;
1968-
wait() if kill('KILL', $watchdog); };";
1951+
# Add END block to parent to terminate and clean up watchdog
1952+
# process
1953+
$cancel_string =~ s/HERE/wait() if kill('KILL', $watchdog)/;
1954+
eval("END { $cancel_string };");
19691955
return;
19701956
}
19711957

@@ -2000,10 +1986,10 @@ ($;$)
20001986
# fork() failed - fall through and try using a thread
20011987
}
20021988

2003-
# Use a watchdog thread because either 'threads' is loaded,
2004-
# or fork() failed
1989+
# Use a watchdog thread because either 'threads' is loaded, or fork()
1990+
# failed
20051991
if (eval {require threads; 1}) {
2006-
$watchdog_thread = 'threads'->create(sub {
1992+
$::watchdog_thread_ = 'threads'->create(sub {
20071993
# Load POSIX if available
20081994
eval { require POSIX; };
20091995

@@ -2027,12 +2013,15 @@ ($;$)
20272013
kill($sig, $pid_to_kill);
20282014
});
20292015

2016+
$cancel_string =~ s/HERE/$::watchdog_thread_->kill('KILL')->detach()/;
2017+
eval "END { $cancel_string }";
2018+
20302019
# Don't proceed until the watchdog has set up its signal handler.
20312020
# (Otherwise there is a possibility that we will exit with threads
20322021
# running.) The watchdog tells us that the handler is set by
20332022
# detaching itself. (The 'is_running()' is a fail-safe.)
2034-
while ( $watchdog_thread->is_running()
2035-
&& ! $watchdog_thread->is_detached())
2023+
while ( $::watchdog_thread_->is_running()
2024+
&& ! $::watchdog_thread_->is_detached())
20362025
{
20372026
'threads'->yield();
20382027
}
@@ -2054,6 +2043,9 @@ ($;$)
20542043
my $sig = $is_vms ? 'TERM' : 'KILL';
20552044
kill($sig, $pid_to_kill);
20562045
};
2046+
2047+
$cancel_string =~ s/HERE/alarm(0)/;
2048+
eval "END { $cancel_string }";
20572049
}
20582050
}
20592051
} # End closure

0 commit comments

Comments
 (0)