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

3 files changed, 40 insertions, 10 deletions

diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index d664c627df..4e5244b6bb 100644
--- 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 feeb5cf9a9..f92cb65c06 100644
--- 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 d7d9bda2a6..395e2b9ee0 100644
--- 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