Upgrade to Time-HiRes-1.9705
Steve Peters [Wed, 7 Feb 2007 14:56:05 +0000 (14:56 +0000)]
p4raw-id: //depot/perl@30157

MANIFEST
ext/Time/HiRes/Changes
ext/Time/HiRes/HiRes.pm
ext/Time/HiRes/HiRes.xs
ext/Time/HiRes/Makefile.PL
ext/Time/HiRes/hints/linux.pl [new file with mode: 0644]
ext/Time/HiRes/t/HiRes.t

index a795818..d671ac0 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1172,6 +1172,7 @@ ext/Time/HiRes/hints/aix.pl       Hint for Time::HiRes for named architecture
 ext/Time/HiRes/hints/dec_osf.pl                Hint for Time::HiRes for named architecture
 ext/Time/HiRes/hints/dynixptx.pl       Hint for Time::HiRes for named architecture
 ext/Time/HiRes/hints/irix.pl   Hint for Time::HiRes for named architecture
+ext/Time/HiRes/hints/linux.pl  Hints for Time::HiRes for named architecture
 ext/Time/HiRes/hints/sco.pl    Hints for Time::HiRes for named architecture
 ext/Time/HiRes/hints/solaris.pl        Hints for Time::HiRes for named architecture
 ext/Time/HiRes/hints/svr4.pl   Hints for Time::HiRes for named architecture
index dc4fe51..cebc812 100644 (file)
@@ -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
index b666341..7d31760 100644 (file)
@@ -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
index fcf93bb..731df21 100644 (file)
@@ -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
 
index b9888ea..cc725b2 100644 (file)
@@ -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 (file)
index 0000000..84ce522
--- /dev/null
@@ -0,0 +1,2 @@
+# needs to explicitly link against librt to pull in clock_nanosleep
+$self->{LIBS} = ['-lrt'];
index 3be8d3c..d9c5739 100644 (file)
@@ -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) {