Turn off watchdog when done in tests

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.
This commit is contained in:
Karl Williamson 2025-09-02 17:00:32 -06:00 committed by Karl Williamson
parent e7a8320d07
commit a7f3f23c84
20 changed files with 33 additions and 1 deletions

View File

@ -26,6 +26,8 @@ for my $t (1 .. 3) {
})->join;
}
watchdog(0);
print "all is well\n";
----
all is well

View File

@ -128,7 +128,7 @@ if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
# New tests go here ^^^
{ # Keep these tests last, as whole script will be interrupted if times out
# Bug #72998; this can loop
# Bug #72998; this can loop
watchdog(10);
eval '"\x{100}\x{FB00}" =~ /\x{100}\N{U+66}+/i';
pass("Didn't loop");
@ -137,6 +137,7 @@ if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
no warnings; # Because the 8 may be warned on
eval 'qr/\18/';
pass(q"qr/\18/ didn't loop");
watchdog(0);
}
done_testing();

View File

@ -42,3 +42,5 @@ SKIP:
kill $killsig, $pid;
open STDIN, "<&", $savein;
}
watchdog(0);

View File

@ -102,3 +102,4 @@ print "# waiting for process $pid4 to exit\n";
$reap_pid = waitpid $pid4, 0;
is( $reap_pid, $pid4, 'fourth process reaped' );
watchdog(0);

View File

@ -300,6 +300,7 @@ watchdog 3;
*foo:: = \%::;
*Acme::META::Acme:: = \*Acme::; # indirect self-reference
pass("mro_package_moved and self-referential packages");
watchdog 0;
# Deleting a glob whose name does not indicate its location in the symbol
# table but which nonetheless *is* in the symbol table.

View File

@ -368,6 +368,7 @@ watchdog 3;
*ᕘ:: = \%::;
*Aᶜme::Mῌ::Aᶜme:: = \*Aᶜme::; # indirect self-reference
pass("mro_package_moved and self-referential packages");
watchdog 0;
# Deleting a glob whose name does not indicate its location in the symbol
# table but which nonetheless *is* in the symbol table.

View File

@ -167,3 +167,5 @@ like $@, qr/No such hook: __DIE__\\0whoops at/;
is($int_called, 1);
is($@, "died");
}
watchdog(0);

View File

@ -73,3 +73,5 @@ foreach my $dupe (@duplicate_signals) {
is( $SIG{$canonical_name}, undef, "The signal $canonical_name is cleared after local goes out of scope." );
}
watchdog(0);

View File

@ -158,3 +158,5 @@ TODO: {
push @got, $_ foreach $a =~ /[^x]d(?{$a .= ''})[^x]d/g;
is("@got", 'ydyd ydyd', '#92696 $a .= \'\' inside (?{}), $a studied');
}
watchdog(0);

View File

@ -149,6 +149,7 @@ watchdog(180, "process");
$_->join for @t;
ok(1, '[perl #45053]');
}
watchdog(0);
sub matchit {
is (ref $_[1], "Regexp");

View File

@ -248,3 +248,5 @@ SKIP: {
is scalar gmtime("NaN"), undef, '[perl #123495] gmtime(NaN)';
is scalar localtime("NaN"), undef, 'localtime(NaN)';
}
watchdog(0);

View File

@ -14,3 +14,5 @@ watchdog(2);
local $SIG{__WARN__} = sub {};
is gmtime(2**69), undef;
is localtime(2**69), undef;
watchdog(0);

View File

@ -35,5 +35,6 @@ watchdog(10);
pass("didn't block on waitpid(0, ...)");
}
watchdog(0);
done_testing();

View File

@ -42,4 +42,6 @@ SKIP: {
pass("COW 1Mb strings");
}
watchdog(0);
1;

View File

@ -61,4 +61,6 @@ my $taint = substr($ENV{PATH}, 0, 0); # and empty tainted string
pass("RT #130584 pos on tainted utf8 string");
}
watchdog(0);
1;

View File

@ -1101,6 +1101,7 @@ foreach my $test (sort { numerically } keys %{$tests_ref}) {
}
}
watchdog(0);
plan($count);
1

View File

@ -35,6 +35,8 @@ plan tests => 15; # Update this when adding/deleting tests.
run_tests() unless caller;
watchdog(0);
#
# Tests start here.
#

View File

@ -161,6 +161,8 @@ PROG
like("!\xdf", eval 'qr/\pp(?aai)\xdf/',
'Compiling qr/\pp(?aai)\xdf/ doesn\'t loop');
watchdog(0);
} # End of sub run_tests
1;

View File

@ -882,6 +882,7 @@ fresh_perl_is( '$_="abcdefg123456"; s/(?<=...\G)?(\d)/($1)/; print' => 'abcdefg(
::is($fc, 1, '$tied_ref =~ s/non-utf8/utf8/ fetch count');
::like("$s", qr/^\x{101}AR\(0x.*\)\z/,
'$tied_ref =~ s/non-utf8/utf8/ result');
::watchdog(0);
}
# RT #97954

View File

@ -24,4 +24,6 @@ for(1..100) {
}
PERL
watchdog(0);
done_testing();