Upgrade to Time::HiRes 1.66

p4raw-id: //depot/perl@23975

4 files changed, 129 insertions, 43 deletions

diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
index 6277ea6b18..dfcb9d91d7 100644
--- a/ext/Time/HiRes/Changes
+++ b/ext/Time/HiRes/Changes
@@ -1,5 +1,13 @@
 Revision history for Perl extension Time::HiRes.
 
+1.66
+	- add nanosleep()
+	- fix the 'hierachy' typo in Makefile.PL [rt.cpan.org #8492]
+	- should now build in Solaris [rt.cpan.org #7165] (since 1.64)
+	- should now build in Cygwin [rt.cpan.org #7535] (since 1.64)
+	- close also [rt.cpan.org #5933] "Time::HiRes::time does not pick up time adjustments like ntp" since ever reproducing it in the same environment
+	  has become rather unlikely
+
 1.65
 	- one should not mix u?alarm and sleep (the tests modified
 	  by 1.65, #12 and #13, hung in Solaris), now we just busy
diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index e47e09c75e..42326fddd0 100644
--- a/ext/Time/HiRes/HiRes.pm
+++ b/ext/Time/HiRes/HiRes.pm
@@ -10,12 +10,12 @@ require DynaLoader;
 
 @EXPORT = qw( );
 @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
-		 getitimer setitimer
+		 getitimer setitimer nanosleep
 		 ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF
 		 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
 		 d_nanosleep);
 	
-$VERSION = '1.65';
+$VERSION = '1.66';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -54,9 +54,10 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 
 =head1 SYNOPSIS
 
-  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
+  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep );
 
   usleep ($microseconds);
+  nanosleep ($nanoseconds);
 
   ualarm ($microseconds);
   ualarm ($microseconds, $interval_microseconds);
@@ -84,20 +85,20 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 =head1 DESCRIPTION
 
 The C<Time::HiRes> module implements a Perl interface to the
-C<usleep>, C<ualarm>, C<gettimeofday>, and C<setitimer>/C<getitimer>
-system calls, in other words, high resolution time and timers. See the
-L</EXAMPLES> section below and the test scripts for usage; see your
-system documentation for the description of the underlying
-C<nanosleep> or C<usleep>, C<ualarm>, C<gettimeofday>, and
-C<setitimer>/C<getitimer> calls.
+C<usleep>, C<nanosleep>, C<ualarm>, C<gettimeofday>, and
+C<setitimer>/C<getitimer> system calls, in other words, high
+resolution time and timers. See the L</EXAMPLES> section below and the
+test scripts for usage; see your system documentation for the
+description of the underlying C<nanosleep> or C<usleep>, C<ualarm>,
+C<gettimeofday>, and C<setitimer>/C<getitimer> calls.
 
 If your system lacks C<gettimeofday()> or an emulation of it you don't
 get C<gettimeofday()> or the one-argument form of C<tv_interval()>.
 If your system lacks all of C<nanosleep()>, C<usleep()>, and
-C<select()>, you don't get C<Time::HiRes::usleep()> or
-C<Time::HiRes::sleep()>.  If your system lacks both C<ualarm()> and
-C<setitimer()> you don't get C<Time::HiRes::ualarm()> or
-C<Time::HiRes::alarm()>.
+C<select()>, you don't get C<Time::HiRes::usleep()>,
+C<Time::HiRes::nanosleep()>, or C<Time::HiRes::sleep()>.  If your
+system lacks both C<ualarm()> and C<setitimer()> you don't get
+C<Time::HiRes::ualarm()> or C<Time::HiRes::alarm()>.
 
 If you try to import an unimplemented function in the C<use> statement
 it will fail at compile time.
@@ -108,9 +109,7 @@ C<nanosleep()> does not use signals.  This, however, is not portable,
 and you should first check for the truth value of
 C<&Time::HiRes::d_nanosleep> to see whether you have nanosleep, and
 then carefully read your C<nanosleep()> C API documentation for any
-peculiarities.  (There is no separate interface to call
-C<nanosleep()>; just use C<Time::HiRes::sleep()> or
-C<Time::HiRes::usleep()> with small enough values.)
+peculiarities.
 
 Unless using C<nanosleep> for mixing sleeping with signals, give
 some thought to whether Perl is the tool you should be using for
@@ -129,9 +128,23 @@ seconds like C<Time::HiRes::time()> (see below).
 
 =item usleep ( $useconds )
 
-Sleeps for the number of microseconds specified.  Returns the number
-of microseconds actually slept.  Can sleep for more than one second,
-unlike the C<usleep> system call. See also C<Time::HiRes::sleep()> below.
+Sleeps for the number of microseconds (millionths of a second)
+specified.  Returns the number of microseconds actually slept.  Can
+sleep for more than one second, unlike the C<usleep> system call. See
+also C<Time::HiRes::usleep()> and C<Time::HiRes::sleep()>.
+
+Do not expect usleep() to be exact down to one microsecond.
+
+=item nanosleep ( $nanoseconds )
+
+Sleeps for the number of nanoseconds (1e9ths of a second) specified.
+Returns the number of nanoseconds actually slept (accurate only to
+microseconds, the nearest thousand of them).  Can sleep for more than
+one second.  See also C<Time::HiRes::sleep()> and
+C<Time::HiRes::usleep()>.
+
+Do not expect nanosleep() to be exact down to one nanosecond.
+Getting even accuracy of one thousand nanoseconds is good.
 
 =item ualarm ( $useconds [, $interval_useconds ] )
 
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index 76352e2acd..3272748fa8 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -351,18 +351,18 @@ gettimeofday (struct timeval *tp, void *tpz)
   * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
 #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
 #define HAS_USLEEP
-#define usleep hrt_nanosleep  /* could conflict with ncurses for static build */
+#define usleep hrt_unanosleep  /* could conflict with ncurses for static build */
 
 void
-hrt_nanosleep(unsigned long usec)
+hrt_unanosleep(unsigned long usec) /* This is used to emulate usleep. */
 {
     struct timespec res;
     res.tv_sec = usec/1000/1000;
     res.tv_nsec = ( usec - res.tv_sec*1000*1000 ) * 1000;
     nanosleep(&res, NULL);
 }
-#endif
 
+#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
 
 #if !defined(HAS_USLEEP) && defined(HAS_SELECT)
 #ifndef SELECT_IS_BROKEN
@@ -379,7 +379,7 @@ hrt_usleep(unsigned long usec)
 		(Select_fd_set_t)NULL, &tv);
 }
 #endif
-#endif
+#endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */
 
 #if !defined(HAS_USLEEP) && defined(WIN32)
 #define HAS_USLEEP
@@ -392,7 +392,7 @@ hrt_usleep(unsigned long usec)
     msec = usec / 1000;
     Sleep (msec);
 }
-#endif
+#endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
 
 
 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
@@ -409,7 +409,7 @@ hrt_ualarm(int usec, int interval)
    itv.it_interval.tv_usec = interval % 1000000;
    return setitimer(ITIMER_REAL, &itv, 0);
 }
-#endif
+#endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
 
 #if !defined(HAS_UALARM) && defined(VMS)
 #define HAS_UALARM
@@ -606,7 +606,7 @@ ualarm_AST(Alarm *a)
     }
 }
 
-#endif /* !HAS_UALARM && VMS */
+#endif /* #if !defined(HAS_UALARM) && defined(VMS) */
 
 #ifdef HAS_GETTIMEOFDAY
 
@@ -633,7 +633,7 @@ myNVtime()
   return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0;
 }
 
-#endif
+#endif /* #ifdef HAS_GETTIMEOFDAY */
 
 MODULE = Time::HiRes            PACKAGE = Time::HiRes
 
@@ -700,6 +700,38 @@ usleep(useconds)
 	OUTPUT:
 	RETVAL
 
+#if defined(TIME_HIRES_NANOSLEEP)
+
+NV
+nanosleep(nseconds)
+        NV nseconds
+	PREINIT:
+	struct timeval Ta, Tb;
+	CODE:
+	gettimeofday(&Ta, NULL);
+	if (items > 0) {
+	    struct timespec tsa;
+	    if (nseconds > 1E9) {
+		IV seconds = (IV) (nseconds / 1E9);
+		if (seconds) {
+		    sleep(seconds);
+		    nseconds -= 1E9 * seconds;
+		}
+	    } else if (nseconds < 0.0)
+	        croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nseconds);
+	    tsa.tv_sec  = (IV) (nseconds / 1E9);
+	    tsa.tv_nsec = (IV) nseconds - tsa.tv_sec * 1E9;
+	    nanosleep(&tsa, NULL);
+	} else
+	    PerlProc_pause();
+	gettimeofday(&Tb, NULL);
+	RETVAL = 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec));
+
+	OUTPUT:
+	RETVAL
+
+#endif /* #if defined(TIME_HIRES_NANOSLEEP) */
+
 NV
 sleep(...)
 	PREINIT:
@@ -719,7 +751,7 @@ sleep(...)
 		    * circumstances (if the double is cast to UV more
 		    * than once?) evaluate to -0.5, instead of 0.5. */
 		   useconds = -(IV)useconds;
-#endif
+#endif /* #if defined(__sparc64__) && defined(__GNUC__) */
 		   if ((IV)useconds < 0)
 		     croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds);
 		 }
@@ -737,7 +769,7 @@ sleep(...)
 	OUTPUT:
 	RETVAL
 
-#endif
+#endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 
 #ifdef HAS_UALARM
 
@@ -766,7 +798,7 @@ alarm(seconds,interval=0)
 	OUTPUT:
 	RETVAL
 
-#endif
+#endif /* #ifdef HAS_UALARM */
 
 #ifdef HAS_GETTIMEOFDAY
 #    ifdef MACOS_TRADITIONAL	/* fix epoch TZ and use unsigned time_t */
@@ -832,7 +864,7 @@ time()
 	RETVAL
 
 #    endif	/* MACOS_TRADITIONAL */
-#endif
+#endif /* #ifdef HAS_GETTIMEOFDAY */
 
 #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
 
@@ -879,5 +911,6 @@ getitimer(which)
 	  }
 	}
 
-#endif
+#endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
+
 
diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t
index 528ab70b78..617468e3a3 100644
--- a/ext/Time/HiRes/t/HiRes.t
+++ b/ext/Time/HiRes/t/HiRes.t
@@ -12,7 +12,7 @@ BEGIN {
     }
 }
 
-BEGIN { $| = 1; print "1..25\n"; }
+BEGIN { $| = 1; print "1..28\n"; }
 
 END {print "not ok 1\n" unless $loaded;}
 
@@ -26,11 +26,13 @@ use strict;
 
 my $have_gettimeofday	= defined &Time::HiRes::gettimeofday;
 my $have_usleep		= defined &Time::HiRes::usleep;
+my $have_nanosleep	= defined &Time::HiRes::nanosleep;
 my $have_ualarm		= defined &Time::HiRes::ualarm;
 my $have_time		= defined &Time::HiRes::time;
 
 import Time::HiRes 'gettimeofday'	if $have_gettimeofday;
 import Time::HiRes 'usleep'		if $have_usleep;
+import Time::HiRes 'nanosleep'		if $have_nanosleep;
 import Time::HiRes 'ualarm'		if $have_ualarm;
 
 use Config;
@@ -41,11 +43,10 @@ my $waitfor = 60; # 10 seconds is normal.
 my $pid;
 
 if ($have_fork) {
-    print "# Testing process $$\n";
-    print "# Starting the timer process\n";
+    print "# I am process $$, starting the timer process\n";
     if (defined ($pid = fork())) {
 	if ($pid == 0) { # We are the kid, set up the timer.
-	    print "# Timer process $$\n";
+	    print "# I am timer process $$\n";
 	    sleep($waitfor);
 	    warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded\n";
 	    print "# Terminating the testing process\n";
@@ -349,29 +350,60 @@ if ($have_gettimeofday) {
     }
 }
 
+if (!$have_nanosleep) {
+    skip 22..23;
+}
+else {
+    my $one = CORE::time;
+    nanosleep(10_000_000);
+    my $two = CORE::time;
+    nanosleep(10_000_000);
+    my $three = CORE::time;
+    ok 22, $one == $two || $two == $three, "slept too long, $one $two $three";
+
+    if (!$have_gettimeofday) {
+    	skip 23;
+    }
+    else {
+    	my $f = Time::HiRes::time();
+	nanosleep(500_000_000);
+        my $f2 = Time::HiRes::time();
+	my $d = $f2 - $f;
+	ok 23, $d > 0.4 && $d < 0.9, "slept $d secs $f to $f2";
+    }
+}
+
 eval { sleep(-1) };
 print $@ =~ /::sleep\(-1\): negative time not invented yet/ ?
-    "ok 22\n" : "not ok 22\n";
+    "ok 24\n" : "not ok 24\n";
 
 eval { usleep(-2) };
 print $@ =~ /::usleep\(-2\): negative time not invented yet/ ?
-    "ok 23\n" : "not ok 23\n";
+    "ok 25\n" : "not ok 25\n";
 
 if ($have_ualarm) {
     eval { alarm(-3) };
     print $@ =~ /::alarm\(-3, 0\): negative time not invented yet/ ?
-	"ok 24\n" : "not ok 24\n";
+	"ok 26\n" : "not ok 26\n";
 
     eval { ualarm(-4) };
     print $@ =~ /::ualarm\(-4, 0\): negative time not invented yet/ ?
-    "ok 25\n" : "not ok 25\n";
+    "ok 27\n" : "not ok 27\n";
+} else {
+    skip 26;
+    skip 27;
+}
+
+if ($have_nanosleep) {
+    eval { nanosleep(-5) };
+    print $@ =~ /::nanosleep\(-5\): negative time not invented yet/ ?
+	"ok 28\n" : "not ok 28\n";
 } else {
-    skip 24;
-    skip 25;
+    skip 28;
 }
 
 if (defined $pid) {
-    print "# Terminating the timer process $pid\n";
+    print "# I am process $$, terminating the timer process $pid\n";
     kill('TERM', $pid); # We are done, the timer can go.
     unlink("ktrace.out");
 }