mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 08:38:23 +00:00
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:
parent
e7a8320d07
commit
a7f3f23c84
@ -26,6 +26,8 @@ for my $t (1 .. 3) {
|
||||
})->join;
|
||||
}
|
||||
|
||||
watchdog(0);
|
||||
|
||||
print "all is well\n";
|
||||
----
|
||||
all is well
|
||||
|
||||
@ -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();
|
||||
|
||||
@ -42,3 +42,5 @@ SKIP:
|
||||
kill $killsig, $pid;
|
||||
open STDIN, "<&", $savein;
|
||||
}
|
||||
|
||||
watchdog(0);
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -167,3 +167,5 @@ like $@, qr/No such hook: __DIE__\\0whoops at/;
|
||||
is($int_called, 1);
|
||||
is($@, "died");
|
||||
}
|
||||
|
||||
watchdog(0);
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -149,6 +149,7 @@ watchdog(180, "process");
|
||||
$_->join for @t;
|
||||
ok(1, '[perl #45053]');
|
||||
}
|
||||
watchdog(0);
|
||||
|
||||
sub matchit {
|
||||
is (ref $_[1], "Regexp");
|
||||
|
||||
@ -248,3 +248,5 @@ SKIP: {
|
||||
is scalar gmtime("NaN"), undef, '[perl #123495] gmtime(NaN)';
|
||||
is scalar localtime("NaN"), undef, 'localtime(NaN)';
|
||||
}
|
||||
|
||||
watchdog(0);
|
||||
|
||||
@ -14,3 +14,5 @@ watchdog(2);
|
||||
local $SIG{__WARN__} = sub {};
|
||||
is gmtime(2**69), undef;
|
||||
is localtime(2**69), undef;
|
||||
|
||||
watchdog(0);
|
||||
|
||||
@ -35,5 +35,6 @@ watchdog(10);
|
||||
|
||||
pass("didn't block on waitpid(0, ...)");
|
||||
}
|
||||
watchdog(0);
|
||||
|
||||
done_testing();
|
||||
|
||||
@ -42,4 +42,6 @@ SKIP: {
|
||||
pass("COW 1Mb strings");
|
||||
}
|
||||
|
||||
watchdog(0);
|
||||
|
||||
1;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -1101,6 +1101,7 @@ foreach my $test (sort { numerically } keys %{$tests_ref}) {
|
||||
}
|
||||
}
|
||||
|
||||
watchdog(0);
|
||||
plan($count);
|
||||
|
||||
1
|
||||
|
||||
@ -35,6 +35,8 @@ plan tests => 15; # Update this when adding/deleting tests.
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
watchdog(0);
|
||||
|
||||
#
|
||||
# Tests start here.
|
||||
#
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -24,4 +24,6 @@ for(1..100) {
|
||||
}
|
||||
PERL
|
||||
|
||||
watchdog(0);
|
||||
|
||||
done_testing();
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user