]> git.vpit.fr Git - perl/modules/VPIT-TestHelpers.git/blobdiff - lib/VPIT/TestHelpers.pm
Add 'select' to the documentation of the 'usleep' feature
[perl/modules/VPIT-TestHelpers.git] / lib / VPIT / TestHelpers.pm
index 65fc2569ba1c2a70776d4cd99d11bb3327bd1f13..476ce9ba92e837164e5f775ac308ff2e205304e5 100644 (file)
@@ -680,7 +680,7 @@ where :
 
 =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.
+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
@@ -718,17 +718,37 @@ sub init_usleep {
     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 $s = int($_[0] / 1e6);
-    my $t = sleep $s;
+   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<Time::HiRes sleep> unless @impls;
+ @impls = qw<Time::HiRes select sleep> unless @impls;
 
  my $usleep;
  for my $impl (@impls) {