From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 16 Oct 2001 01:55:48 +0000 (+0000)
Subject: Make Time::HiRes::sleep() and usleep() to return
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52d72fba699bcf7fedd294a01c1a7481f6cfddd5;p=p5sagit%2Fp5-mst-13.2.git

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