Upgrade to Time-HiRes-1.9705

p4raw-id: //depot/perl@30157

6 files changed, 65 insertions, 54 deletions

diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
index dc4fe51a95..cebc81234c 100644
--- a/ext/Time/HiRes/Changes
+++ b/ext/Time/HiRes/Changes
@@ -1,5 +1,11 @@
 Revision history for the Perl extension Time::HiRes.
 
+1.9705	[2007-02-06]
+	- nanosleep() and clock_nanosleep() detection and use were
+	  quite broken; in Linux -lrt needed; fixes from Zefram
+	- [internal] slightly cleaner building of $DEFINE in Makefile.PL,
+	  should avoid double/conflicting -D flags
+
 1.9704	[2007-01-01]
 	- allow 10% of slop in test #14 (testing difference between
 	  CORE::time() and Time::HiRes::time()), there seem to be often
diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index b666341ffd..7d31760573 100644
--- a/ext/Time/HiRes/HiRes.pm
+++ b/ext/Time/HiRes/HiRes.pm
@@ -23,7 +23,7 @@ require DynaLoader;
 		 stat
 		);
 	
-$VERSION = '1.9704';
+$VERSION = '1.9705';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -119,8 +119,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
   $realtime   = clock_gettime(CLOCK_REALTIME);
   $resolution = clock_getres(CLOCK_REALTIME);
 
-  clock_nanosleep(CLOCK_REALTIME, 1.5);
-  clock_nanosleep(CLOCK_REALTIME, time() + 10, TIMER_ABSTIME);
+  clock_nanosleep(CLOCK_REALTIME, 1.5e9);
+  clock_nanosleep(CLOCK_REALTIME, time()*1e9 + 10e9, TIMER_ABSTIME);
 
   my $ticktock = clock();
 
@@ -347,10 +347,10 @@ specified by C<$which>.  All implementations that support POSIX high
 resolution timers are supposed to support at least the C<$which> value
 of C<CLOCK_REALTIME>, see L</clock_gettime>.
 
-=item clock_nanosleep ( $which, $seconds, $flags = 0)
+=item clock_nanosleep ( $which, $nanoseconds, $flags = 0)
 
-Sleeps for the number of seconds (1e9ths of a second) specified.
-Returns the number of seconds actually slept.  The $which is the
+Sleeps for the number of nanoseconds (1e9ths of a second) specified.
+Returns the number of nanoseconds actually slept.  The $which is the
 "clock id", as with clock_gettime() and clock_getres().  The flags
 default to zero but C<TIMER_ABSTIME> can specified (must be exported
 explicitly) which means that C<$nanoseconds> is not a time interval
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index fcf93bb54e..731df21bce 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -817,31 +817,24 @@ NV
 nanosleep(nsec)
         NV nsec
 	PREINIT:
-	int status = -1;
-	struct timeval Ta, Tb;
+	struct timespec sleepfor, unslept;
 	CODE:
-	gettimeofday(&Ta, NULL);
-	if (items > 0) {
-	    struct timespec ts1;
-	    if (nsec > 1E9) {
-		IV sec = (IV) (nsec / 1E9);
-		if (sec) {
-		    sleep(sec);
-		    nsec -= 1E9 * sec;
-		}
-	    } else if (nsec < 0.0)
-	        croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec);
-	    ts1.tv_sec  = (IV) (nsec / 1E9);
-	    ts1.tv_nsec = (IV) nsec - (IV) (ts1.tv_sec * NV_1E9);
-	    status = nanosleep(&ts1, NULL);
+	if (nsec < 0.0)
+	    croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec);
+	sleepfor.tv_sec = nsec / 1e9;
+	sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9;
+	if (!nanosleep(&sleepfor, &unslept)) {
+	    RETVAL = nsec;
 	} else {
-	    PerlProc_pause();
-	    status = 0;
+	    sleepfor.tv_sec -= unslept.tv_sec;
+	    sleepfor.tv_nsec -= unslept.tv_nsec;
+	    if (sleepfor.tv_nsec < 0) {
+		sleepfor.tv_sec--;
+		sleepfor.tv_nsec += 1000000000;
+	    }
+	    RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
 	}
-	gettimeofday(&Tb, NULL);
-	RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
-
-	OUTPUT:
+    OUTPUT:
 	RETVAL
 
 #else  /* #if defined(TIME_HIRES_NANOSLEEP) */
@@ -1145,27 +1138,28 @@ clock_getres(clock_id = 0)
 #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
 
 NV
-clock_nanosleep(clock_id = CLOCK_REALTIME, sec = 0.0, flags = 0)
+clock_nanosleep(clock_id, nsec, flags = 0)
 	int clock_id
-	NV  sec
+	NV  nsec
 	int flags
     PREINIT:
-	int status = -1;
-	struct timespec ts;
-	struct timeval Ta, Tb;
+	struct timespec sleepfor, unslept;
     CODE:
-	gettimeofday(&Ta, NULL);
-	if (items > 1) {
-	    ts.tv_sec  = (IV) sec;
-	    ts.tv_nsec = (sec - (NV) ts.tv_sec) * (NV) 1E9;
-	    status = clock_nanosleep(clock_id, flags, &ts, NULL);
+	if (nsec < 0.0)
+	    croak("Time::HiRes::clock_nanosleep(..., %"NVgf"): negative time not invented yet", nsec);
+	sleepfor.tv_sec = nsec / 1e9;
+	sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9;
+	if (!clock_nanosleep(clock_id, flags, &sleepfor, &unslept)) {
+	    RETVAL = nsec;
 	} else {
-	    PerlProc_pause();
-	    status = 0;
+	    sleepfor.tv_sec -= unslept.tv_sec;
+	    sleepfor.tv_nsec -= unslept.tv_nsec;
+	    if (sleepfor.tv_nsec < 0) {
+		sleepfor.tv_sec--;
+		sleepfor.tv_nsec += 1000000000;
+	    }
+	    RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
 	}
-	gettimeofday(&Tb, NULL);
-	RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
-
     OUTPUT:
 	RETVAL
 
diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL
index b9888eac99..cc725b2a59 100644
--- a/ext/Time/HiRes/Makefile.PL
+++ b/ext/Time/HiRes/Makefile.PL
@@ -342,11 +342,12 @@ sub has_clock_nanosleep {
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#include <time.h>
 int main(int argc, char** argv)
 {
     int ret;
-    struct timerspec ts1;
-    struct timerspec ts2;
+    struct timespec ts1;
+    struct timespec ts2;
     ts1.tv_sec  = 0;
     ts1.tv_nsec = 750000000;;
     ret = clock_nanosleep(CLOCK_MONOTONIC, 0, &ts1, &ts2);
@@ -355,6 +356,14 @@ int main(int argc, char** argv)
 EOM
 }
 
+sub DEFINE {
+    my ($def, $val) = @_;
+    my $define = defined $val ? "$def=$val" : $def ;
+    unless ($DEFINE =~ /(?:^| )-D\Q$define\E(?: |$)/) {
+	$DEFINE .= " -D$define";
+    }
+}
+
 sub init {
     my $hints = File::Spec->catfile("hints", "$^O.pl");
     if (-f $hints) {
@@ -614,7 +623,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtimespec++;
-      $DEFINE .= ' -DTIME_HIRES_STAT=1';
+      DEFINE('TIME_HIRES_STAT', 1);
     }
 
     if ($has_stat_st_xtimespec) {
@@ -634,7 +643,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtimensec++;
-      $DEFINE .= ' -DTIME_HIRES_STAT=2';
+      DEFINE('TIME_HIRES_STAT', 2);
     }
 
     if ($has_stat_st_xtimensec) {
@@ -654,7 +663,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtime_n++;
-      $DEFINE .= ' -DTIME_HIRES_STAT=3';
+      DEFINE('TIME_HIRES_STAT', 3);
     }
 
     if ($has_stat_st_xtime_n) {
@@ -674,7 +683,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtim++;
-      $DEFINE .= ' -DTIME_HIRES_STAT=4';
+      DEFINE('TIME_HIRES_STAT', 4);
     }
 
     if ($has_stat_st_xtim) {
@@ -694,7 +703,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_uxtime++;
-      $DEFINE .= ' -DTIME_HIRES_STAT=5';
+      DEFINE('TIME_HIRES_STAT', 5);
     }
 
     if ($has_stat_st_uxtime) {
@@ -716,7 +725,7 @@ EOM
         print "Looking for <w32api/windows.h>... ";
         if (has_include('w32api/windows.h')) {
 	    $has_w32api_windows_h++;
-	    $DEFINE .= ' -DHAS_W32API_WINDOWS_H';
+	    DEFINE('HAS_W32API_WINDOWS_H');
 	}
         if ($has_w32api_windows_h) {
 	    print "found.\n";
@@ -742,7 +751,7 @@ sub doMakefile {
 	    'AUTHOR'    => 'Jarkko Hietaniemi <jhi@iki.fi>',
 	    'ABSTRACT_FROM' => 'HiRes.pm',
 	);
-	$DEFINE .= " -DATLEASTFIVEOHOHFIVE";
+	DEFINE('ATLEASTFIVEOHOHFIVE');
     }
 
     push (@makefileopts,
@@ -826,7 +835,7 @@ sub main {
     }
 
     if ($^O =~ /Win32/i) {
-      $DEFINE = '-DSELECT_IS_BROKEN';
+      DEFINE('SELECT_IS_BROKEN');
       $LIBS = [];
       print "System is $^O, skipping full configure...\n";
     } else {
diff --git a/ext/Time/HiRes/hints/linux.pl b/ext/Time/HiRes/hints/linux.pl
new file mode 100644
index 0000000000..84ce5221b1
--- /dev/null
+++ b/ext/Time/HiRes/hints/linux.pl
@@ -0,0 +1,2 @@
+# needs to explicitly link against librt to pull in clock_nanosleep
+$self->{LIBS} = ['-lrt'];
diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t
index 3be8d3c642..d9c5739fc0 100644
--- a/ext/Time/HiRes/t/HiRes.t
+++ b/ext/Time/HiRes/t/HiRes.t
@@ -560,7 +560,7 @@ if ($have_clock_getres) {
 
 if ($have_clock_nanosleep &&
     has_symbol('CLOCK_REALTIME')) {
-    my $s = 1.5;
+    my $s = 1.5e9;
     my $t = clock_nanosleep(&CLOCK_REALTIME, $s);
     my $r = abs(1 - $t / $s);
     if ($r < 2 * $limit) {