From: Vincent Pit Date: Mon, 20 Apr 2015 14:08:14 +0000 (-0300) Subject: More flexible selection of usleep() implementations X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=ded5cdb5a343bc4e48b7a3f19968af3af55a7c0f;p=perl%2Fmodules%2FVPIT-TestHelpers.git More flexible selection of usleep() implementations Also improve t/50-usleep.t. --- diff --git a/lib/VPIT/TestHelpers.pm b/lib/VPIT/TestHelpers.pm index 2396cad..27c8149 100644 --- a/lib/VPIT/TestHelpers.pm +++ b/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'> 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,39 @@ 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; + } + }, + 'sleep' => sub { + diag 'Using sleep()-based fallback usleep()'; + return sub { + my $s = int($_[0] / 1e6); + sleep $s if $s; + }; + }, + ); + + @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; } diff --git a/t/50-usleep.t b/t/50-usleep.t index 4ed179e..109f4bc 100644 --- a/t/50-usleep.t +++ b/t/50-usleep.t @@ -3,12 +3,32 @@ use strict; use warnings; -use VPIT::TestHelpers 'usleep'; +use VPIT::TestHelpers; -use Test::More tests => 2; +use Test::More; -pass 'before usleep()'; +my @impls = qw; -usleep 100; +for my $impl (@impls) { + my $desc = "$impl-based usleep()"; + { + local $SIG{__WARN__} = sub { + my $msg = join ' ', @_; + if ($msg !~ /Subroutine main::usleep redefined/) { + CORE::warn $msg; + } + return; + }; + VPIT::TestHelpers->import(usleep => [ $impl ]); + } + my $has_usleep = do { + local $@; + eval 'defined &main::usleep'; + }; + ok $has_usleep, "$desc was imported"; + my $ret = usleep(100); + pass "$desc did sleep"; + diag "$desc actually slept $ret microseconds"; +} -pass 'after usleep()'; +done_testing;