From: Vincent Pit Date: Mon, 20 Jul 2015 16:28:55 +0000 (-0300) Subject: Update VPIT::TestHelpers to 3ba261a5 X-Git-Tag: v0.58~10 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=5b5382a5df1d05dbcb54a11a22eb8ec71461a3c6;p=perl%2Fmodules%2FVariable-Magic.git Update VPIT::TestHelpers to 3ba261a5 --- diff --git a/t/lib/VPIT/TestHelpers.pm b/t/lib/VPIT/TestHelpers.pm index 2396cad..476ce9b 100644 --- a/t/lib/VPIT/TestHelpers.pm +++ b/t/lib/VPIT/TestHelpers.pm @@ -672,7 +672,18 @@ sub spawn { Import : - use VPIT::TestHelpers 'usleep' + use VPIT::TestHelpers 'usleep' => [ @impls ]; + +where : + +=over 8 + +=item - + +C<@impls> is the list of desired implementations (which may be C<'Time::HiRes'>, C<'select'> or C<'sleep'>), in the order they should be checked. +When the list is empty, it defaults to all of them. + +=back =item * @@ -695,20 +706,60 @@ C =cut sub init_usleep { - my $usleep; + my (@impls) = @_; - if (do { local $@; eval { require Time::HiRes; 1 } }) { - defined and diag "Using usleep() from Time::HiRes $_" + my %impls = ( + 'Time::HiRes' => sub { + if (do { local $@; eval { require Time::HiRes; 1 } }) { + defined and diag "Using usleep() from Time::HiRes $_" for $Time::HiRes::VERSION; - $usleep = \&Time::HiRes::usleep; - } else { - diag 'Using fallback usleep()'; - $usleep = sub { - my $s = int($_[0] / 1e6); - sleep $s if $s; - }; + return \&Time::HiRes::usleep; + } else { + return undef; + } + }, + 'select' => sub { + if ($Config::Config{d_select}) { + diag 'Using select()-based fallback usleep()'; + return sub ($) { + my $s = $_[0]; + my $r = 0; + while ($s > 0) { + my ($found, $t) = select(undef, undef, undef, $s / 1e6); + last unless defined $t; + $t = int($t * 1e6); + $s -= $t; + $r += $t; + } + return $r; + }; + } else { + return undef; + } + }, + 'sleep' => sub { + diag 'Using sleep()-based fallback usleep()'; + return sub ($) { + my $ms = int $_[0]; + my $s = int($ms / 1e6) + ($ms % 1e6 == 0 ? 0 : 1); + my $t = sleep $s; + return $t * 1e6; + }; + }, + ); + + @impls = qw unless @impls; + + my $usleep; + for my $impl (@impls) { + next unless defined $impl and $impls{$impl}; + $usleep = $impls{$impl}->(); + last if defined $usleep; } + skip_all "Could not find a suitable usleep() implementation among: @impls" + unless $usleep; + return usleep => $usleep; }