Upgrade to Time-HiRes-1.85
authorSteve Peters <steve@fisharerojo.org>
Sat, 17 Dec 2005 01:46:58 +0000 (01:46 +0000)
committerSteve Peters <steve@fisharerojo.org>
Sat, 17 Dec 2005 01:46:58 +0000 (01:46 +0000)
p4raw-id: //depot/perl@26383

ext/Time/HiRes/Changes
ext/Time/HiRes/HiRes.pm
ext/Time/HiRes/HiRes.xs
ext/Time/HiRes/Makefile.PL
ext/Time/HiRes/fallback/const-c.inc
ext/Time/HiRes/fallback/const-xs.inc
ext/Time/HiRes/t/HiRes.t

index b61607f..1c78b96 100644 (file)
@@ -1,5 +1,26 @@
 Revision history for Perl extension Time::HiRes.
 
+1.85   [2005-12-16]
+       - the interface to clock_nanosleep() is more natural
+         when it is like (hires) time() (instead of like nanosleep),
+         and the .xs implementation of clock_nanosleep() in 1.84
+         was broken anyway
+       - the semantics of clock() are not quite so silly as I thought,
+         but still somewhat odd, documented as such
+       - additional enhancements to the clock() documentation
+       - add test for clock_nanosleep() (I cannot test this
+         since none of my systems have the function)
+       - add test for clock()
+
+1.84   [2005-12-16]
+       - add clock() which returns the processor time in
+         (floating point) seconds since an arbitrary era
+       - add clock_nanosleep() which suspends the current
+         thread until either absolute time or for relative time
+       - [rt.cpan.org #16486] printf missing value in HiRes.t
+       - add constants CLOCKS_PER_SEC, CLOCK_SOFTTIME, TIMER_ABSTIME
+       - tiny typo fixes
+
 1.83   [2005-11-19]
        - has_symbol() was wrong since e.g. ITIMER_VIRTUAL is exported
          via @EXPORT_OK even when it is not available.  This is heinous.
@@ -175,7 +196,7 @@ Revision history for Perl extension Time::HiRes.
 
 1.63   [2004-09-01]
        - Win32 and any ithread build: ppport.h didn't define
-         MY_CXT_CLONE, which seems to be a Time-HiResism.
+         MY_CXT_CLONE, which seems to be a Time-HiRes-ism.
 
 1.62   [2004-08-31]
        - Skip testing if under PERL_CORE and Time::HiRes has not
@@ -427,7 +448,7 @@ Revision history for Perl extension Time::HiRes.
        - 13422: XS segfault, from Marc Lehmann
        - 13378: whether select() gets restarted on signals, depends
        - 13354: timing constraints, again, from Andy Dougherty
-       - 13278: can't do subecond alarms with ualarm;
+       - 13278: can't do subsecond alarms with ualarm;
                 break out early if alarms do not seem to be working
        - 13266: test relaxation (cygwin gets lower hires
                 times than lores ones)
@@ -598,7 +619,7 @@ Revision history for Perl extension Time::HiRes.
              - fix EXPORT_FAIL. 
          This work was all done by Roderick Schertler
          <roderick@argon.org>. If you run Linux or
-         one of the other ualarm-less platoforms, and you like this 
+         one of the other ualarm-less platforms, and you like this 
          module, let Roderick know; without him, it still wouldn't 
          be working on those boxes...
        - Makefile.PL: figure out what routines the OS has and
index 2b4269f..d8a1832 100644 (file)
@@ -11,13 +11,17 @@ require DynaLoader;
 @EXPORT = qw( );
 @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
                 getitimer setitimer nanosleep clock_gettime clock_getres
+                clock clock_nanosleep
                 CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID
-                CLOCK_REALTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY
+                CLOCK_REALTIME CLOCK_SOFTTIME CLOCK_THREAD_CPUTIME_ID
+                CLOCK_TIMEOFDAY CLOCKS_PER_SEC
                 ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF
+                TIMER_ABSTIME
                 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
-                d_nanosleep d_clock_gettime d_clock_getres);
+                d_nanosleep d_clock_gettime d_clock_getres
+                d_clock d_clock_nanosleep);
        
-$VERSION = '1.83';
+$VERSION = '1.85';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -42,11 +46,13 @@ sub AUTOLOAD {
 sub import {
     my $this = shift;
     for my $i (@_) {
-       if (($i eq 'clock_getres'  && !&d_clock_getres)  ||
-           ($i eq 'clock_gettime' && !&d_clock_gettime) ||
-           ($i eq 'nanosleep'     && !&d_nanosleep)     ||
-           ($i eq 'usleep'        && !&d_usleep)        ||
-           ($i eq 'ualarm'        && !&d_ualarm)) {
+       if (($i eq 'clock_getres'    && !&d_clock_getres)    ||
+           ($i eq 'clock_gettime'   && !&d_clock_gettime)   ||
+           ($i eq 'clock_nanosleep' && !&d_clock_nanosleep) ||
+           ($i eq 'clock'           && !&d_clock)           ||
+           ($i eq 'nanosleep'       && !&d_nanosleep)       ||
+           ($i eq 'usleep'          && !&d_usleep)          ||
+           ($i eq 'ualarm'          && !&d_ualarm)) {
            require Carp;
            Carp::croak("Time::HiRes::$i(): unimplemented in this platform");
        }
@@ -77,7 +83,7 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 =head1 SYNOPSIS
 
   use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep
-                     clock_gettime clock_getres );
+                     clock_gettime clock_getres clock_nanosleep clock );
 
   usleep ($microseconds);
   nanosleep ($nanoseconds);
@@ -108,6 +114,10 @@ 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, TIMER_ABSTIME);
+
+  my $ticktock = clock();
+
 =head1 DESCRIPTION
 
 The C<Time::HiRes> module implements a Perl interface to the
@@ -156,8 +166,10 @@ seconds like C<Time::HiRes::time()> (see 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()>.
+sleep for more than one second, unlike the C<usleep> system call. Can
+also sleep for zero seconds, which often works like a I<thread yield>.
+See also C<Time::HiRes::usleep()>, C<Time::HiRes::sleep()>, and
+C<Time::HiRes::clock_nanosleep()>.
 
 Do not expect usleep() to be exact down to one microsecond.
 
@@ -166,8 +178,9 @@ Do not expect usleep() to be exact down to one microsecond.
 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()>.
+one second.  Can also sleep for zero seconds, which often works like a
+I<thread yield>.  See also C<Time::HiRes::sleep()>,
+C<Time::HiRes::usleep()>, and C<Time::HiRes::clock_nanosleep()>.
 
 Do not expect nanosleep() to be exact down to one nanosecond.
 Getting even accuracy of one thousand nanoseconds is good.
@@ -310,7 +323,38 @@ documentation for other possibly supported values.
 Return as seconds the resolution of the POSIX high resolution timer
 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>.
+of C<CLOCK_REALTIME>, see L</clock_gettime>.
+
+=item clock_nanosleep ( $which, $seconds, $flags = 0)
+
+Sleeps for the number of seconds (1e9ths of a second) specified.
+Returns the number of seconds 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
+(as is the default) but instead an absolute time.  Can sleep for more
+than one second.  Can also sleep for zero seconds, which often works
+like a I<thread yield>.  See also C<Time::HiRes::sleep()>,
+C<Time::HiRes::usleep()>, and C<Time::HiRes::nanosleep()>.
+
+Do not expect clock_nanosleep() to be exact down to one nanosecond.
+Getting even accuracy of one thousand nanoseconds is good.
+
+=item clock()
+
+Return as seconds the I<process time> (user + system time) spent by
+the process since the first call to clock() (the definition is B<not>
+"since the start of the process", though if you are lucky these times
+may be quite close to each other, depending on the system).  What this
+means is that you probably need to store the result of your first call
+to clock(), and subtract that value from the following results of clock().
+
+The time returned also includes the process times of the terminated
+child processes for which wait() has been executed.  This value is
+somewhat like the second value returned by the times() of core Perl,
+but not necessarily identical.  Note that due to backward
+compatibility limitations the returned may wrap around at about 2147
+seconds or at about 36 minutes.
 
 =back
 
@@ -366,6 +410,16 @@ of C<CLOCK_REALTIME>,  see L</clock_gettime>.
   # But how accurate we can be, really?
   my $reso = clock_getres(CLOCK_REALTIME);
 
+  use Time::HiRes qw( clock_nanosleep TIMER_ABSTIME );
+  clock_nanosleep(CLOCK_REALTIME, 1e6);
+  clock_nanosleep(CLOCK_REALTIME, 2e9, TIMER_ABSTIME);
+
+  use Time::HiRes qw( clock );
+  my $clock0 = clock();
+  ... # Do something.
+  my $clock1 = clock();
+  my $clockd = $clock1 - $clock0;
+
 =head1 C API
 
 In addition to the perl API described above, a C API is available for
index d4d1304..8883be8 100644 (file)
@@ -427,10 +427,10 @@ hrt_usleep(unsigned long usec)
 void
 hrt_usleep(unsigned long usec)
 {
-       struct timespec tsa;
-       tsa.tv_sec  = usec * 1000; /* Ignoring wraparound. */
-       tsa.tv_nsec = 0;
-       nanosleep(&tsa, NULL);
+       struct timespec ts1;
+       ts1.tv_sec  = usec * 1000; /* Ignoring wraparound. */
+       ts1.tv_nsec = 0;
+       nanosleep(&ts1, NULL);
 }
 
 #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
@@ -756,29 +756,32 @@ usleep(useconds)
 #if defined(TIME_HIRES_NANOSLEEP)
 
 NV
-nanosleep(nseconds)
-        NV nseconds
+nanosleep(nsec)
+        NV nsec
        PREINIT:
+       int status = -1;
        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;
+           struct timespec ts1;
+           if (nsec > 1E9) {
+               IV sec = (IV) (nsec / 1E9);
+               if (sec) {
+                   sleep(sec);
+                   nsec -= 1E9 * sec;
                }
-           } 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
+           } 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 - ts1.tv_sec * 1E9;
+           status = nanosleep(&ts1, NULL);
+       } else {
            PerlProc_pause();
+           status = 0;
+       }
        gettimeofday(&Tb, NULL);
-       RETVAL = 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec));
+       RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
 
        OUTPUT:
        RETVAL
@@ -786,8 +789,8 @@ nanosleep(nseconds)
 #else  /* #if defined(TIME_HIRES_NANOSLEEP) */
 
 NV
-nanosleep(nseconds)
-        NV nseconds
+nanosleep(nsec)
+        NV nsec
     CODE:
         croak("Time::HiRes::nanosleep(): unimplemented in this platform");
         RETVAL = 0.0;
@@ -1074,3 +1077,63 @@ clock_getres(clock_id = 0)
 
 #endif /*  #if defined(TIME_HIRES_CLOCK_GETRES) */
 
+#if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
+
+NV
+clock_nanosleep(clock_id = CLOCK_REALTIME, sec = 0.0, flags = 0)
+       int clock_id
+       NV  sec
+       int flags
+    PREINIT:
+       int status = -1;
+       struct timespec ts;
+       struct timeval Ta, Tb;
+    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);
+       } else {
+           PerlProc_pause();
+           status = 0;
+       }
+       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
+
+#else  /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
+
+NV
+clock_nanosleep()
+    CODE:
+        croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform");
+        RETVAL = 0.0;
+
+#endif /*  #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
+
+#if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC)
+
+NV
+clock()
+    PREINIT:
+       clock_t clocks;
+    CODE:
+       clocks = clock();
+       RETVAL = clocks == -1 ? -1 : (NV)clocks / (NV)CLOCKS_PER_SEC;
+
+    OUTPUT:
+       RETVAL
+
+#else  /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
+
+NV
+clock()
+    CODE:
+        croak("Time::HiRes::clock(): unimplemented in this platform");
+        RETVAL = 0.0;
+
+#endif /*  #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
+
index bce235e..5e54b49 100644 (file)
@@ -272,7 +272,7 @@ EOM
     return 0;
 }
 
-sub has_clock_x_syscall {
+sub has_clock_xxx_syscall {
     my $x = shift;
     return 0 unless defined $SYSCALL_H;
     return 1 if
@@ -292,8 +292,8 @@ int main _((int argc, char** argv, char** env))
 EOM
 }
 
-sub has_clock_x {
-    my $x = shift;
+sub has_clock_xxx {
+    my $xxx = shift;
     return 1 if
     try_compile_and_link(<<EOM, run => 1);
 #include "EXTERN.h"
@@ -302,13 +302,47 @@ sub has_clock_x {
 int main _((int argc, char** argv, char** env))
 {
     struct timespec ts;
-    int ret = clock_$x(CLOCK_REALTIME, &ts); /* Many Linuxes get ENOSYS. */
+    int ret = clock_$xxx(CLOCK_REALTIME, &ts); /* Many Linuxes get ENOSYS. */
     /* All implementations are supposed to support CLOCK_REALTIME. */
     ret == 0 ? exit(0) : exit(errno ? errno : -1);
 }
 EOM
 }
 
+sub has_clock {
+    return 1 if
+    try_compile_and_link(<<EOM, run => 1);
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+int main _((int argc, char** argv, char** env))
+{
+    clock_t tictoc;
+    clock_t ret = clock();
+    ret == (clock_t)-1 ? exit(errno ? errno : -1) : exit(0);
+}
+EOM
+}
+
+sub has_clock_nanosleep {
+    return 1 if
+    try_compile_and_link(<<EOM, run => 1);
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+int main _((int argc, char** argv, char** env))
+{
+    int ret;
+    struct timerspec ts1;
+    struct timerspec ts2;
+    ts1.tv_sec  = 0;
+    ts1.tv_nsec = 750000000;;
+    ret = clock_nanosleep(CLOCK_MONOTONIC, 0, &ts1, &ts2);
+    ret == 0 ? exit(0) : exit(errno ? errno : -1);
+}
+EOM
+}
+
 sub init {
     my $hints = File::Spec->catfile("hints", "$^O.pl");
     if (-f $hints) {
@@ -485,10 +519,10 @@ EOD
     my $has_clock_gettime;
     if (exists $Config{d_clock_gettime}) {
         $has_clock_gettime++ if $Config{d_clock_gettime}; # Unlikely...
-    } elsif (has_clock_x('gettime')) {
+    } elsif (has_clock_xxx('gettime')) {
         $has_clock_gettime++;
        $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME';
-    } elsif (defined $SYSCALL_H && has_clock_x_syscall('gettime')) {
+    } elsif (defined $SYSCALL_H && has_clock_xxx_syscall('gettime')) {
         $has_clock_gettime++;
        $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_SYSCALL';
     }
@@ -507,10 +541,10 @@ EOD
     my $has_clock_getres;
     if (exists $Config{d_clock_getres}) {
         $has_clock_getres++ if $Config{d_clock_getres}; # Unlikely...
-    } elsif (has_clock_x('getres')) {
+    } elsif (has_clock_xxx('getres')) {
         $has_clock_getres++;
        $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES';
-    } elsif (defined $SYSCALL_H && has_clock_x_syscall('getres')) {
+    } elsif (defined $SYSCALL_H && has_clock_xxx_syscall('getres')) {
         $has_clock_getres++;
        $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_SYSCALL';
     }
@@ -525,7 +559,38 @@ EOD
        print "NOT found.\n";
     }
 
+    print "Looking for clock_nanosleep()... ";
+    my $has_clock_nanosleep;
+    if (exists $Config{d_clock_nanosleep}) {
+        $has_clock_nanosleep++ if $Config{d_clock_nanosleep}; # Unlikely...
+    } elsif (has_clock_nanosleep()) {
+        $has_clock_nanosleep++;
+       $DEFINE .= ' -DTIME_HIRES_CLOCK_NANOSLEEP';
+    }
+
+    if ($has_clock_nanosleep) {
+        print "found.\n";
+    } else {
+       print "NOT found.\n";
+    }
+
+    print "Looking for clock()... ";
+    my $has_clock;
+    if (exists $Config{d_clock}) {
+        $has_clock++ if $Config{d_clock}; # Unlikely...
+    } elsif (has_clock()) {
+        $has_clock++;
+       $DEFINE .= ' -DTIME_HIRES_CLOCK';
+    }
+
+    if ($has_clock) {
+        print "found.\n";
+    } else {
+       print "NOT found.\n";
+    }
+
     my $has_w32api_windows_h;
+
     if ($^O eq 'cygwin') {
         print "Looking for <w32api/windows.h>... ";
         if (has_include('w32api/windows.h')) {
@@ -590,14 +655,18 @@ sub doConstants {
        my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC
                        CLOCK_PROCESS_CPUTIME_ID
                        CLOCK_REALTIME
+                       CLOCK_SOFTTIME
                        CLOCK_THREAD_CPUTIME_ID
                        CLOCK_TIMEOFDAY
+                       CLOCKS_PER_SEC
                        ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
-                       ITIMER_REALPROF));
+                       ITIMER_REALPROF
+                       TIMER_ABSTIME));
        foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
-                    d_nanosleep d_clock_gettime d_clock_getres)) {
+                    d_nanosleep d_clock_gettime d_clock_getres
+                    d_clock d_clock_nanosleep)) {
            my $macro = $_;
-           if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres)$/) {
+           if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres|d_clock|d_clock_nanosleep)$/) {
                $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
            } else {
                $macro =~ s/^d_(.+)/HAS_\U$1/;
index 6038faa..86028f1 100644 (file)
@@ -19,6 +19,7 @@ typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
 #ifndef pTHX_
 #define pTHX_ /* 5.6 or later define this for threading support.  */
 #endif
+
 static int
 constant_11 (pTHX_ const char *name, IV *iv_return) {
   /* When generated this function returned values for the list of names given
@@ -90,12 +91,13 @@ static int
 constant_14 (pTHX_ const char *name, IV *iv_return) {
   /* When generated this function returned values for the list of names given
      here.  However, subsequent manual editing may have added or removed some.
-     CLOCK_REALTIME ITIMER_VIRTUAL d_clock_getres d_gettimeofday */
-  /* Offset 6 gives the best switch position.  */
-  switch (name[6]) {
-  case 'R':
+     CLOCKS_PER_SEC CLOCK_REALTIME CLOCK_SOFTTIME ITIMER_VIRTUAL d_clock_getres
+     d_gettimeofday */
+  /* Offset 8 gives the best switch position.  */
+  switch (name[8]) {
+  case 'A':
     if (memEQ(name, "CLOCK_REALTIME", 14)) {
-    /*                     ^              */
+    /*                       ^            */
 #ifdef CLOCK_REALTIME
       *iv_return = CLOCK_REALTIME;
       return PERL_constant_ISIV;
@@ -104,9 +106,31 @@ constant_14 (pTHX_ const char *name, IV *iv_return) {
 #endif
     }
     break;
-  case '_':
+  case 'E':
+    if (memEQ(name, "CLOCKS_PER_SEC", 14)) {
+    /*                       ^            */
+#ifdef CLOCKS_PER_SEC
+      *iv_return = CLOCKS_PER_SEC;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'F':
+    if (memEQ(name, "CLOCK_SOFTTIME", 14)) {
+    /*                       ^            */
+#ifdef CLOCK_SOFTTIME
+      *iv_return = CLOCK_SOFTTIME;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'I':
     if (memEQ(name, "ITIMER_VIRTUAL", 14)) {
-    /*                     ^              */
+    /*                       ^            */
 #ifdef ITIMER_VIRTUAL
       *iv_return = ITIMER_VIRTUAL;
       return PERL_constant_ISIV;
@@ -115,9 +139,9 @@ constant_14 (pTHX_ const char *name, IV *iv_return) {
 #endif
     }
     break;
-  case 'i':
+  case 'e':
     if (memEQ(name, "d_gettimeofday", 14)) {
-    /*                     ^              */
+    /*                       ^            */
 #ifdef HAS_GETTIMEOFDAY
       *iv_return = 1;
       return PERL_constant_ISIV;
@@ -127,9 +151,9 @@ constant_14 (pTHX_ const char *name, IV *iv_return) {
 #endif
     }
     break;
-  case 'k':
+  case 'g':
     if (memEQ(name, "d_clock_getres", 14)) {
-    /*                     ^              */
+    /*                       ^            */
 #ifdef TIME_HIRES_CLOCK_GETRES
       *iv_return = 1;
       return PERL_constant_ISIV;
@@ -216,11 +240,14 @@ constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
 
 my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID
-              CLOCK_REALTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY
-              ITIMER_PROF ITIMER_REAL ITIMER_REALPROF ITIMER_VIRTUAL),
+my @names = (qw(CLOCKS_PER_SEC CLOCK_HIGHRES CLOCK_MONOTONIC
+              CLOCK_PROCESS_CPUTIME_ID CLOCK_REALTIME CLOCK_SOFTTIME
+              CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY ITIMER_PROF ITIMER_REAL
+              ITIMER_REALPROF ITIMER_VIRTUAL TIMER_ABSTIME),
+            {name=>"d_clock", type=>"IV", macro=>"TIME_HIRES_CLOCK", value=>"1", default=>["IV", "0"]},
             {name=>"d_clock_getres", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETRES", value=>"1", default=>["IV", "0"]},
             {name=>"d_clock_gettime", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETTIME", value=>"1", default=>["IV", "0"]},
+            {name=>"d_clock_nanosleep", type=>"IV", macro=>"TIME_HIRES_CLOCK_NANOSLEEP", value=>"1", default=>["IV", "0"]},
             {name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]},
             {name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]},
             {name=>"d_nanosleep", type=>"IV", macro=>"TIME_HIRES_NANOSLEEP", value=>"1", default=>["IV", "0"]},
@@ -238,6 +265,17 @@ __END__
    */
 
   switch (len) {
+  case 7:
+    if (memEQ(name, "d_clock", 7)) {
+#ifdef TIME_HIRES_CLOCK
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
   case 8:
     /* Names all of length 8.  */
     /* d_ualarm d_usleep */
@@ -273,13 +311,32 @@ __END__
     return constant_11 (aTHX_ name, iv_return);
     break;
   case 13:
-    if (memEQ(name, "CLOCK_HIGHRES", 13)) {
+    /* Names all of length 13.  */
+    /* CLOCK_HIGHRES TIMER_ABSTIME */
+    /* Offset 2 gives the best switch position.  */
+    switch (name[2]) {
+    case 'M':
+      if (memEQ(name, "TIMER_ABSTIME", 13)) {
+      /*                 ^                 */
+#ifdef TIMER_ABSTIME
+        *iv_return = TIMER_ABSTIME;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'O':
+      if (memEQ(name, "CLOCK_HIGHRES", 13)) {
+      /*                 ^                 */
 #ifdef CLOCK_HIGHRES
-      *iv_return = CLOCK_HIGHRES;
-      return PERL_constant_ISIV;
+        *iv_return = CLOCK_HIGHRES;
+        return PERL_constant_ISIV;
 #else
-      return PERL_constant_NOTDEF;
+        return PERL_constant_NOTDEF;
 #endif
+      }
+      break;
     }
     break;
   case 14:
@@ -288,6 +345,17 @@ __END__
   case 15:
     return constant_15 (aTHX_ name, iv_return);
     break;
+  case 17:
+    if (memEQ(name, "d_clock_nanosleep", 17)) {
+#ifdef TIME_HIRES_CLOCK_NANOSLEEP
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
   case 23:
     if (memEQ(name, "CLOCK_THREAD_CPUTIME_ID", 23)) {
 #ifdef CLOCK_THREAD_CPUTIME_ID
index 9412046..c84dd05 100644 (file)
@@ -86,4 +86,3 @@ constant(sv)
                type, s));
           PUSHs(sv);
         }
-
index ad4959e..b0969f0 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
     }
 }
 
-BEGIN { $| = 1; print "1..31\n"; }
+BEGIN { $| = 1; print "1..33\n"; }
 
 END { print "not ok 1\n" unless $loaded }
 
@@ -24,12 +24,14 @@ print "ok 1\n";
 
 use strict;
 
-my $have_gettimeofday  = &Time::HiRes::d_gettimeofday;
-my $have_usleep                = &Time::HiRes::d_usleep;
-my $have_nanosleep     = &Time::HiRes::d_nanosleep;
-my $have_ualarm                = &Time::HiRes::d_ualarm;
-my $have_clock_gettime = &Time::HiRes::d_clock_gettime;
-my $have_clock_getres  = &Time::HiRes::d_clock_getres;
+my $have_gettimeofday   = &Time::HiRes::d_gettimeofday;
+my $have_usleep                 = &Time::HiRes::d_usleep;
+my $have_nanosleep      = &Time::HiRes::d_nanosleep;
+my $have_ualarm                 = &Time::HiRes::d_ualarm;
+my $have_clock_gettime  = &Time::HiRes::d_clock_gettime;
+my $have_clock_getres   = &Time::HiRes::d_clock_getres;
+my $have_clock_nanosleep = &Time::HiRes::d_clock_nanosleep;
+my $have_clock           = &Time::HiRes::d_clock;
 
 sub has_symbol {
     my $symbol = shift;
@@ -39,12 +41,14 @@ sub has_symbol {
     return $@ eq '';
 }
 
-printf "# have_gettimeofday  = %d\n", $have_gettimeofday;
-printf "# have_usleep        = %d\n", $have_usleep;
-printf "# have_nanosleep     = %d\n", $have_nanosleep;
-printf "# have_ualarm        = %d\n", $have_ualarm;
-printf "# have_clock_gettime = %d\n", $have_clock_gettime;
-printf "# have_clock_getres  = %d\n", $have_clock_getres;
+printf "# have_gettimeofday    = %d\n", $have_gettimeofday;
+printf "# have_usleep          = %d\n", $have_usleep;
+printf "# have_nanosleep       = %d\n", $have_nanosleep;
+printf "# have_ualarm          = %d\n", $have_ualarm;
+printf "# have_clock_gettime   = %d\n", $have_clock_gettime;
+printf "# have_clock_getres    = %d\n", $have_clock_getres;
+printf "# have_clock_nanosleep = %d\n", $have_clock_nanosleep;
+printf "# have_clock           = %d\n", $have_clock;
 
 import Time::HiRes 'gettimeofday'      if $have_gettimeofday;
 import Time::HiRes 'usleep'            if $have_usleep;
@@ -52,6 +56,8 @@ import Time::HiRes 'nanosleep'                if $have_nanosleep;
 import Time::HiRes 'ualarm'            if $have_ualarm;
 import Time::HiRes 'clock_gettime'     if $have_clock_gettime;
 import Time::HiRes 'clock_getres'      if $have_clock_getres;
+import Time::HiRes 'clock_nanosleep'   if $have_clock_nanosleep;
+import Time::HiRes 'clock'             if $have_clock;
 
 use Config;
 
@@ -519,7 +525,7 @@ if ($have_clock_gettime &&
                print "# Error: t0 = $t0, t1 = $t1\n";
            }
            my $r = rand() + rand();
-           printf "# Sleeping for %.6f seconds...\n";
+           printf "# Sleeping for %.6f seconds...\n", $r;
            sleep($r);
        }
     }
@@ -535,16 +541,51 @@ if ($have_clock_gettime &&
 
 if ($have_clock_getres) {
     my $tr = clock_getres();
-   if ($tr > 0) {
-       print "ok 31 # tr = $tr\n";
-   } else {
-       print "not ok 31 # tr = $tr\n";
-   }
+    if ($tr > 0) {
+       print "ok 31 # tr = $tr\n";
+    } else {
+       print "not ok 31 # tr = $tr\n";
+    }
 } else {
     print "# No clock_getres\n";
     skip 31;
 }
 
+if ($have_clock_nanosleep &&
+    has_symbol('CLOCK_REALTIME')) {
+    my $s = 1.5;
+    my $t = clock_nanosleep(&CLOCK_REALTIME, $s);
+    my $r = abs(1 - $t / $s);
+    if ($r < 2 * $limit) {
+       print "ok 32\n";
+    } else {
+       print "not ok 32 # $t = $t, r = $r\n";
+    }
+} else {
+    print "# No clock_nanosleep\n";
+    skip 32;
+}
+
+if ($have_clock) {
+    my @clock = clock();
+    print "# clock = @clock\n";
+    for my $i (1..3) {
+       for (my $j = 0; $j < 1e6; $j++) { }
+       push @clock, clock();
+       print "# clock = @clock\n";
+    }
+    if ($clock[1] > $clock[0] &&
+       $clock[2] > $clock[1] &&
+       $clock[3] > $clock[2]) {
+       print "ok 32\n";
+    } else {
+       print "not ok 33\n";
+    }
+} else {
+    print "# No clock\n";
+    skip 33;
+}
+
 END {
     if (defined $timer_pid) {
        my $left = $TheEnd - time();