Make Time::HiRes::sleep() and usleep() to return

the number of seconds (a floating point value) and
microseconds (an integer) actually slept (well,
modulo the time spent in measuring the time actually
slept...), to be a better drop-in replacement for
the builtin sleep().  Noticed by Chris Nandor.

Also make usleep() to croak if fed illegal number
of useconds (anything greater than 1_000_000).

p4raw-id: //depot/perl@12449

diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index d664c62..4e5244b 100644 (file)
--- a/ext/Time/HiRes/HiRes.pm
+++ b/ext/Time/HiRes/HiRes.pm
@@ -105,8 +105,10 @@ seconds like Time::HiRes::time() (see below).
 
 =item usleep ( $useconds )
 
-Issues a usleep for the number of microseconds specified. See also 
-Time::HiRes::sleep() below.
+Issues a usleep for the number of microseconds specified.  Returns the
+number of microseconds actually slept.  The number of microseconds
+B<must> be between 0 and 1_000_0000 (inclusive): you B<cannot> sleep
+a minute by usleep(60_000_000).  See also Time::HiRes::sleep() below.
 
 =item ualarm ( $useconds [, $interval_useconds ] )
 
@@ -143,9 +145,11 @@ separate values.
 
 =item sleep ( $floating_seconds )
 
-Converts $floating_seconds to microseconds and issues a usleep for the 
-result.  This function can be imported, resulting in a nice drop-in 
-replacement for the C<sleep> provided with perl, see the EXAMPLES below.
+Converts $floating_seconds to microseconds and issues a usleep for the
+result.  Returns the number of seconds actually slept (a floating
+point value).  This function can be imported, resulting in a nice
+drop-in replacement for the C<sleep> provided with perl, see the
+EXAMPLES below.
 
 =item alarm ( $floating_seconds [, $interval_floating_seconds ] )
 

diff --git a/ext/Time/HiRes/HiRes.t b/ext/Time/HiRes/HiRes.t
index feeb5cf..f92cb65 100644 (file)
--- a/ext/Time/HiRes/HiRes.t
+++ b/ext/Time/HiRes/HiRes.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-BEGIN { $| = 1; print "1..19\n"; }
+BEGIN { $| = 1; print "1..21\n"; }
 
 END {print "not ok 1\n" unless $loaded;}
 
@@ -223,3 +223,7 @@ unless (defined &Time::HiRes::setitimer
     $SIG{VTALRM} = 'DEFAULT';
 }
 
+print abs(sleep(1)                  - 1) < 0.001 ? "ok 20\n" : "not ok 20\n";
+
+print abs(usleep(1000000) / 1000000 - 1) < 0.001 ? "ok 21\n" : "not ok 21\n";
+

diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index d7d9bda..395e2b9 100644 (file)
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -367,20 +367,42 @@ constant(name, arg)
        char *          name
        int             arg
 
-#ifdef HAS_USLEEP
+#if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
 
-void
+int
 usleep(useconds)
         int useconds 
+       PREINIT:
+       struct timeval Ta, Tb;
+       CODE:
+       gettimeofday(&Ta, NULL);
+       if (items > 0) {
+           if (useconds > 1000000)
+               croak("usleep: useconds must be between 0 and 1000000 (inclusive)");
+           usleep(useconds);
+       } else
+           PerlProc_pause();
+       gettimeofday(&Tb, NULL);
+       RETVAL = 1000000*(Tb.tv_sec-Ta.tv_sec)+(Tb.tv_usec-Ta.tv_usec);
 
-void
+       OUTPUT:
+       RETVAL
+
+NV
 sleep(...)
-       PROTOTYPE: ;$
+       PREINIT:
+       struct timeval Ta, Tb;
        CODE:
+       gettimeofday(&Ta, NULL);
        if (items > 0)
            usleep((int)(SvNV(ST(0)) * 1000000));
        else
            PerlProc_pause();
+       gettimeofday(&Tb, NULL);
+       RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec);
+
+       OUTPUT:
+       RETVAL
 
 #endif