tests: try to make sleeping portable by avoiding select
select does not support just waiting on Windows: https://perldoc.perl.org/perlport.html#select Reviewed-By: Daniel Stenberg Closes #5035
This commit is contained in:
Родитель
1eecb0e022
Коммит
9aaca09044
33
tests/ftp.pm
33
tests/ftp.pm
|
@ -5,7 +5,7 @@
|
|||
# | (__| |_| | _ <| |___
|
||||
# \___|\___/|_| \_\_____|
|
||||
#
|
||||
# Copyright (C) 1998 - 2010, Daniel Stenberg, <daniel@haxx.se>, et al.
|
||||
# Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
|
||||
#
|
||||
# This software is licensed as described in the file COPYING, which
|
||||
# you should have received as part of this distribution. The terms
|
||||
|
@ -20,6 +20,14 @@
|
|||
#
|
||||
###########################################################################
|
||||
|
||||
BEGIN {
|
||||
# portable sleeping needs Time::HiRes
|
||||
eval {
|
||||
no warnings "all";
|
||||
require Time::HiRes;
|
||||
}
|
||||
}
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
|
@ -29,6 +37,27 @@ use serverhelp qw(
|
|||
datasockf_pidfilename
|
||||
);
|
||||
|
||||
#######################################################################
|
||||
# portable_sleep uses Time::HiRes::sleep if available and falls back
|
||||
# to the classic approach of using select(undef, undef, undef, ...).
|
||||
# even though that one is not portable due to being implemented using
|
||||
# select on Windows: https://perldoc.perl.org/perlport.html#select
|
||||
# On Windows it also just uses full-second sleep for waits >1 second.
|
||||
#
|
||||
sub portable_sleep {
|
||||
my ($seconds) = @_;
|
||||
|
||||
if($Time::HiRes::VERSION) {
|
||||
Time::HiRes::sleep($seconds);
|
||||
}
|
||||
elsif ($seconds > 1 && ($^O eq 'MSWin32' || $^O eq 'msys')) {
|
||||
sleep($seconds);
|
||||
}
|
||||
else {
|
||||
select(undef, undef, undef, $seconds);
|
||||
}
|
||||
}
|
||||
|
||||
#######################################################################
|
||||
# pidfromfile returns the pid stored in the given pidfile. The value
|
||||
# of the returned pid will never be a negative value. It will be zero
|
||||
|
@ -216,7 +245,7 @@ sub killpid {
|
|||
}
|
||||
}
|
||||
last if(not scalar(@signalled));
|
||||
select(undef, undef, undef, 0.05);
|
||||
portable_sleep(0.05);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -493,7 +493,7 @@ sub sendcontrol {
|
|||
|
||||
for(@a) {
|
||||
sockfilt $_;
|
||||
select(undef, undef, undef, 0.01);
|
||||
portable_sleep(0.01);
|
||||
}
|
||||
}
|
||||
my $log;
|
||||
|
@ -530,7 +530,7 @@ sub senddata {
|
|||
# pause between each byte
|
||||
for (split(//,$l)) {
|
||||
sockfiltsecondary $_;
|
||||
select(undef, undef, undef, 0.01);
|
||||
portable_sleep(0.01);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -3199,7 +3199,7 @@ while(1) {
|
|||
logmsg("Sleep for $delay seconds\n");
|
||||
my $twentieths = $delay * 20;
|
||||
while($twentieths--) {
|
||||
select(undef, undef, undef, 0.05) unless($got_exit_signal);
|
||||
portable_sleep(0.05) unless($got_exit_signal);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -482,7 +482,7 @@ sub startnew {
|
|||
logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
|
||||
}
|
||||
# could/should do a while connect fails sleep a bit and loop
|
||||
sleep $timeout;
|
||||
portable_sleep($timeout);
|
||||
if (checkdied($child)) {
|
||||
logmsg "startnew: child process has failed to start\n" if($verbose);
|
||||
return (-1,-1);
|
||||
|
@ -3823,7 +3823,7 @@ sub singletest {
|
|||
if($serverlogslocktimeout) {
|
||||
my $lockretry = $serverlogslocktimeout * 20;
|
||||
while((-f $SERVERLOGS_LOCK) && $lockretry--) {
|
||||
select(undef, undef, undef, 0.05);
|
||||
portable_sleep(0.05);
|
||||
}
|
||||
if(($lockretry < 0) &&
|
||||
($serverlogslocktimeout >= $defserverlogslocktimeout)) {
|
||||
|
@ -3840,7 +3840,7 @@ sub singletest {
|
|||
# based tests might need a small delay once that the client command has
|
||||
# run to avoid false test failures.
|
||||
|
||||
sleep($postcommanddelay) if($postcommanddelay);
|
||||
portable_sleep($postcommanddelay) if($postcommanddelay);
|
||||
|
||||
# timestamp removal of server logs advisor read lock
|
||||
$timesrvrlog{$testnum} = Time::HiRes::time();
|
||||
|
|
Загрузка…
Ссылка в новой задаче