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 2396cade85c2812fbf0cadcf5c3a81e1b613adde..27c814907a08f247b9d5b8c3f0be2c5281922f45 100644 (file)
--- a/lib/VPIT/TestHelpers.pm
+++ b/lib/VPIT/TestHelpers.pm
@@ -672,7 +672,18 @@ sub spawn {
 
 Import :
 
 
 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 *
 
 
 =item *
 


@@ -695,20 +706,39 @@ C<usleep $microseconds>
 =cut
 
 sub init_usleep {
 =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;
                                                       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<Time::HiRes sleep> 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;
 }
 
  return usleep => $usleep;
 }
 

diff --git a/t/50-usleep.t b/t/50-usleep.t
index 4ed179ef80cf9a08c81b67d0720a70d38e053e54..109f4bce915fd6061a6f635f974b1aebda5c72c1 100644 (file)
--- a/t/50-usleep.t
+++ b/t/50-usleep.t
@@ -3,12 +3,32 @@
 use strict;
 use warnings;
 
 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<Time::HiRes sleep>;

 
 

-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;