moparisthebest
/
curl
mirror of https://github.com/moparisthebest/curl
1
0
Fork 0
Code Issues Releases Wiki Activity

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:
Marc Hoersken 2020-03-04 11:44:49 +01:00
parent 1eecb0e022
commit 9aaca09044
No known key found for this signature in database
GPG Key ID: 61E03CBED7BC859E
3 changed files with 37 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
tests/ftp.pm
View File

@ -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 # This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms # 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 strict;
use warnings; use warnings;
@ -29,6 +37,27 @@ use serverhelp qw(
datasockf_pidfilename 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 # 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 # 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)); last if(not scalar(@signalled));
select(undef, undef, undef, 0.05); portable_sleep(0.05);
} }
} }

6
tests/ftpserver.pl
View File

@ -493,7 +493,7 @@ sub sendcontrol {
for(@a) { for(@a) {
sockfilt $_; sockfilt $_;
select(undef, undef, undef, 0.01); portable_sleep(0.01);
} }
} }
my $log; my $log;
@ -530,7 +530,7 @@ sub senddata {
# pause between each byte # pause between each byte
for (split(//,$l)) { for (split(//,$l)) {
sockfiltsecondary $_; sockfiltsecondary $_;
select(undef, undef, undef, 0.01); portable_sleep(0.01);
} }
} }
} }
@ -3199,7 +3199,7 @@ while(1) {
logmsg("Sleep for $delay seconds\n"); logmsg("Sleep for $delay seconds\n");
my $twentieths = $delay * 20; my $twentieths = $delay * 20;
while($twentieths--) { while($twentieths--) {
select(undef, undef, undef, 0.05) unless($got_exit_signal); portable_sleep(0.05) unless($got_exit_signal);
} }
} }

6
tests/runtests.pl
View File

@ -482,7 +482,7 @@ sub startnew {
logmsg "startnew: failed to write fake $pidfile with pid=$child\n"; logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
} }
# could/should do a while connect fails sleep a bit and loop # could/should do a while connect fails sleep a bit and loop
sleep $timeout; portable_sleep($timeout);
if (checkdied($child)) { if (checkdied($child)) {
logmsg "startnew: child process has failed to start\n" if($verbose); logmsg "startnew: child process has failed to start\n" if($verbose);
return (-1,-1); return (-1,-1);
@ -3823,7 +3823,7 @@ sub singletest {
if($serverlogslocktimeout) { if($serverlogslocktimeout) {
my $lockretry = $serverlogslocktimeout * 20; my $lockretry = $serverlogslocktimeout * 20;
while((-f $SERVERLOGS_LOCK) && $lockretry--) { while((-f $SERVERLOGS_LOCK) && $lockretry--) {
select(undef, undef, undef, 0.05); portable_sleep(0.05);
} }
if(($lockretry < 0) && if(($lockretry < 0) &&
($serverlogslocktimeout >= $defserverlogslocktimeout)) { ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
@ -3840,7 +3840,7 @@ sub singletest {
# based tests might need a small delay once that the client command has # based tests might need a small delay once that the client command has
# run to avoid false test failures. # run to avoid false test failures.
sleep($postcommanddelay) if($postcommanddelay); portable_sleep($postcommanddelay) if($postcommanddelay);
# timestamp removal of server logs advisor read lock # timestamp removal of server logs advisor read lock
$timesrvrlog{$testnum} = Time::HiRes::time(); $timesrvrlog{$testnum} = Time::HiRes::time();