Croak() on negative time; doc tweaks.

p4raw-id: //depot/perl@12609

3 files changed, 87 insertions, 49 deletions

diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index 72fc6065df..4e0f55fd8d 100644
--- a/ext/Time/HiRes/HiRes.pm
+++ b/ext/Time/HiRes/HiRes.pm
@@ -47,7 +47,7 @@ __END__
 
 =head1 NAME
 
-Time::HiRes - High resolution ualarm, usleep, and gettimeofday
+Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 
 =head1 SYNOPSIS
 
@@ -80,17 +80,18 @@ Time::HiRes - High resolution ualarm, usleep, and gettimeofday
 
 =head1 DESCRIPTION
 
-The C<Time::HiRes> module implements a Perl interface to the usleep, ualarm,
-and gettimeofday system calls. See the EXAMPLES section below and the test
-scripts for usage; see your system documentation for the description of
-the underlying gettimeofday, usleep, and ualarm calls.
+The C<Time::HiRes> module implements a Perl interface to the usleep,
+ualarm, gettimeofday, and setitimer/getitimer system calls. See the
+EXAMPLES section below and the test scripts for usage; see your system
+documentation for the description of the underlying usleep, ualarm,
+gettimeofday, and setitimer/getitimer calls.
 
-If your system lacks gettimeofday(2) you don't get gettimeofday() or the
-one-arg form of tv_interval().  If you don't have usleep(3) or select(2)
-you don't get usleep() or sleep().  If your system don't have ualarm(3)
-or setitimer(2) you don't get ualarm() or alarm().
-If you try to import an unimplemented function in the C<use> statement
-it will fail at compile time.
+If your system lacks gettimeofday(2) or an emulation of it you don't
+get gettimeofday() or the one-arg form of tv_interval().
+If you don't have usleep(3) or select(2) you don't get usleep()
+or sleep().  If your system don't have ualarm(3) or setitimer(2) you
+don't get ualarm() or alarm().  If you try to import an unimplemented
+function in the C<use> statement it will fail at compile time.
 
 The following functions can be imported from this module.
 No functions are exported by default.
@@ -99,15 +100,15 @@ No functions are exported by default.
 
 =item gettimeofday ()
 
-In array context it returns a 2 element array with the seconds and
-microseconds since the epoch.  In scalar context it returns floating
+In array context returns a 2 element array with the seconds and
+microseconds since the epoch.  In scalar context returns floating
 seconds like Time::HiRes::time() (see below).
 
 =item usleep ( $useconds )
 
-Issues a usleep for the number of microseconds specified.  Returns the
-number of microseconds actually slept.  See also Time::HiRes::sleep()
-below.
+Sleeps for the number of microseconds specified.  Returns the number
+of microseconds actually slept.  Can sleep for more than one second
+unlike the usleep system call. See also Time::HiRes::sleep() below.
 
 =item ualarm ( $useconds [, $interval_useconds ] )
 
@@ -118,17 +119,23 @@ unspecified, resulting in alarm-like behaviour.
 
 S<tv_interval ( $ref_to_gettimeofday [, $ref_to_later_gettimeofday] )>
 
-Returns the floating seconds between the two times, which should have been 
-returned by gettimeofday(). If the second argument is omitted, then the
-current time is used.
+Returns the floating seconds between the two times, which should have
+been returned by gettimeofday(). If the second argument is omitted,
+then the current time is used.
 
 =item time ()
 
-Returns a floating seconds since the epoch. This function can be imported,
-resulting in a nice drop-in replacement for the C<time> provided with perl,
-see the EXAMPLES below.
+Returns a floating seconds since the epoch. This function can be
+imported, resulting in a nice drop-in replacement for the C<time>
+provided with core Perl, see the EXAMPLES below.
 
-B<NOTE>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT
+B<NOTE 1>: this higher resolution timer can return values either less or
+more than the core time(), depending on whether your platforms rounds
+the higher resolution timer values up, down, or to the nearest to get
+the core time(), but naturally the difference should be never more than
+half a second.
+
+B<NOTE 2>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT
 (when the time() seconds since epoch rolled over to 1_000_000_000),
 the default floating point format of Perl and the seconds since epoch
 have conspired to produce an apparent bug: if you print the value of
@@ -144,17 +151,16 @@ separate values.
 
 =item sleep ( $floating_seconds )
 
-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.
+Sleeps for the specified amount of seconds.  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 ] )
 
-Converts $floating_seconds and $interval_floating_seconds and issues
-a ualarm for the results.  The $interval_floating_seconds argument
-is optional and will be 0 if unspecified, resulting in alarm-like
+The SIGALRM signal is sent after the specfified number of seconds.
+Implemented using ualarm().  The $interval_floating_seconds argument
+is optional and will be 0 if unspecified, resulting in alarm()-like
 behaviour.  This function can be imported, resulting in a nice drop-in
 replacement for the C<alarm> provided with perl, see the EXAMPLES below.
 
diff --git a/ext/Time/HiRes/HiRes.t b/ext/Time/HiRes/HiRes.t
index fbf6a3f7ef..887f810fdc 100644
--- a/ext/Time/HiRes/HiRes.t
+++ b/ext/Time/HiRes/HiRes.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-BEGIN { $| = 1; print "1..21\n"; }
+BEGIN { $| = 1; print "1..25\n"; }
 
 END {print "not ok 1\n" unless $loaded;}
 
@@ -223,9 +223,24 @@ unless (defined &Time::HiRes::setitimer
     $SIG{VTALRM} = 'DEFAULT';
 }
 
-$a = abs(sleep(1.5)                    - 1.5);
+$a = abs(sleep(1.5)        / 1.5       - 1.0);
 print $a < 0.1 ? "ok 20 # $a\n" : "not ok 20 # $a\n";
 
 $a = abs(usleep(1_500_000) / 1_500_000 - 1.0);
 print $a < 0.1 ? "ok 21 # $a\n" : "not ok 21 # $a\n";
 
+eval { sleep(-1) };
+print $@ =~ /::sleep\(-1\): negative time not invented yet/ ?
+    "ok 22\n" : "not ok 22\n";
+
+eval { usleep(-2) };
+print $@ =~ /::usleep\(-2\): negative time not invented yet/ ?
+    "ok 23\n" : "not ok 23\n";
+
+eval { alarm(-3) };
+print $@ =~ /::alarm\(-3, 0\): negative time not invented yet/ ?
+    "ok 24\n" : "not ok 24\n";
+
+eval { ualarm(-4) };
+print $@ =~ /::ualarm\(-4, 0\): negative time not invented yet/ ?
+    "ok 25\n" : "not ok 25\n";
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index e0ac4fb8cf..dcc51e90e8 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -379,9 +379,15 @@ usleep(useconds)
 	if (items > 0) {
 	    if (useconds > 1E6) {
 		IV seconds = (IV) (useconds / 1E6);
-		sleep(seconds);
-		useconds -= 1E6 * seconds;
-	    }
+		/* If usleep() has been implemented using setitimer()
+		 * then this contortion is unnecessary-- but usleep()
+		 * may be implemented in some other way, so let's contort. */
+		if (seconds) {
+		    sleep(seconds);
+		    useconds -= 1E6 * seconds;
+		}
+	    } else if (useconds < 0.0)
+	        croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds);
 	    usleep((UV)useconds);
 	} else
 	    PerlProc_pause();
@@ -402,9 +408,12 @@ sleep(...)
 	gettimeofday(&Ta, NULL);
 	if (items > 0) {
 	    NV seconds  = SvNV(ST(0));
-	    IV useconds = 1E6 * (seconds - (IV)seconds);
-	    sleep(seconds);
-	    usleep(useconds);
+	    if (seconds >= 0.0) {
+  	         UV useconds = 1E6 * (seconds - (UV)seconds);
+		 sleep((UV)seconds);
+		 usleep(useconds);
+	    } else
+	        croak("Time::HiRes::sleep(%"NVgf"): negative time not invented yet", seconds);
 	} else
 	    PerlProc_pause();
 	gettimeofday(&Tb, NULL);
@@ -420,21 +429,27 @@ sleep(...)
 
 #ifdef HAS_UALARM
 
-int
+IV
 ualarm(useconds,interval=0)
 	int useconds
 	int interval
+	CODE:
+	if (useconds < 0 || interval < 0)
+	    croak("Time::HiRes::ualarm(%"IVdf", %"IVdf"): negative time not invented yet", useconds, interval);
+	RETVAL = ualarm(useconds, interval);
 
-int
-alarm(fseconds,finterval=0)
-	NV fseconds
-	NV finterval
-	PREINIT:
-	int useconds, uinterval;
+	OUTPUT:
+	RETVAL
+
+NV
+alarm(seconds,interval=0)
+	NV seconds
+	NV interval
 	CODE:
-	useconds = fseconds * 1000000;
-	uinterval = finterval * 1000000;
-	RETVAL = ualarm (useconds, uinterval);
+	if (seconds < 0.0 || interval < 0.0)
+	    croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
+	RETVAL = (NV)ualarm(seconds  * 1000000,
+			    interval * 1000000) / 1E6;
 
 	OUTPUT:
 	RETVAL
@@ -520,6 +535,8 @@ setitimer(which, seconds, interval = 0)
 	struct itimerval newit;
 	struct itimerval oldit;
     PPCODE:
+	if (seconds < 0.0 || interval < 0.0)
+	    croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative time not invented yet", which, seconds, interval);
 	newit.it_value.tv_sec  = seconds;
 	newit.it_value.tv_usec =
 	  (seconds  - (NV)newit.it_value.tv_sec)    * 1000000.0;