Upgrade to Time-HiRes-1.77

p4raw-id: //depot/perl@25970

7 files changed, 548 insertions, 68 deletions

diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
index 3f7adc2a4e..60f5c71eda 100644
--- a/ext/Time/HiRes/Changes
+++ b/ext/Time/HiRes/Changes
@@ -1,5 +1,14 @@
 Revision history for Perl extension Time::HiRes.
 
+1.77	[2005-10-03]
+	- add support for the POSIX clock_gettime() and clock_getres(),
+	  if available, either as library calls or as syscalls
+	- be more defensive about missing functionality: break out
+	  early (during 'use') if no e.g. clock_getres() is available,
+	  and protect our back by trapping those cases also in HiRes.xs
+	- the test added in 1.76 could cause an endless loop e.g. in Solaris,
+	  due to mixing of sleep() and alarm() (bad programmer, no cookie!)
+
 1.76	[2005-10-22]
 	- testing for nanosleep had wrong logic which caused nanosleep
 	  to become undefined for e.g. Mac OS X
diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index 70aab16466..6064fb5939 100644
--- a/ext/Time/HiRes/HiRes.pm
+++ b/ext/Time/HiRes/HiRes.pm
@@ -10,20 +10,24 @@ require DynaLoader;
 
 @EXPORT = qw( );
 @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
-		 getitimer setitimer nanosleep
+		 getitimer setitimer nanosleep clock_gettime clock_getres
+		 CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID
+		 CLOCK_REALTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY
 		 ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF
 		 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
-		 d_nanosleep);
+		 d_nanosleep d_clock_gettime d_clock_getres);
 	
-$VERSION = '1.76';
+$VERSION = '1.77';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
 sub AUTOLOAD {
     my $constname;
     ($constname = $AUTOLOAD) =~ s/.*:://;
+    # print "AUTOLOAD: constname = $constname ($AUTOLOAD)\n";
     die "&Time::HiRes::constant not defined" if $constname eq 'constant';
     my ($error, $val) = constant($constname);
+    # print "AUTOLOAD: error = $error, val = $val\n";
     if ($error) {
         my (undef,$file,$line) = caller;
         die "$error at $file line $line.\n";
@@ -35,6 +39,21 @@ sub AUTOLOAD {
     goto &$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)) {
+	    require Carp;
+	    Carp::croak("Time::HiRes::$i(): unimplemented in this platform");
+	}
+    }
+    Time::HiRes->export_to_level(1, $this, @_);
+}
+
 bootstrap Time::HiRes;
 
 # Preloaded methods go here.
@@ -57,7 +76,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
 
 =head1 SYNOPSIS
 
-  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep );
+  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep
+		      clock_gettime clock_getres );
 
   usleep ($microseconds);
   nanosleep ($nanoseconds);
@@ -85,6 +105,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
   setitimer ($which, $floating_seconds, $floating_interval );
   getitimer ($which);
 
+  $realtime = clock_gettime(CLOCK_REALTIME);
+
 =head1 DESCRIPTION
 
 The C<Time::HiRes> module implements a Perl interface to the
@@ -174,7 +196,8 @@ B<NOTE 1>: This higher resolution timer can return values either less
 or more than the core C<time()>, depending on whether your platform
 rounds the higher resolution timer values up, down, or to the nearest second
 to get the core C<time()>, but naturally the difference should be never
-more than half a second.
+more than half a second.  See also L</clock_getres>, if available
+in your system.
 
 B<NOTE 2>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT, when
 the C<time()> seconds since epoch rolled over to 1_000_000_000, the
@@ -267,6 +290,27 @@ In scalar context, the remaining time is returned.
 In list context, both the remaining time and the interval are returned.
 The interval is always what you put in using C<setitimer()>.
 
+=item clock_gettime ( $which )
+
+Return as seconds the current value 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>, which is supposed to return results close to the
+results of C<gettimeofday>, or the number of seconds since 00:00:00:00
+January 1, 1970 Greenwich Mean Time (GMT).  Do not assume that
+CLOCK_REALTIME is zero, it might be one, or something else.
+Another potentially useful (but not available everywhere) value is
+C<CLOCK_MONOTONIC>, which guarantees a monotonically increasing time
+value (unlike time(), which can be adjusted).  See your system
+documentation for other possibly supported values.
+
+=item clock_getres ( $which )
+
+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>.
+
 =back
 
 =head1 EXAMPLES
@@ -315,6 +359,10 @@ The interval is always what you put in using C<setitimer()>.
   $SIG{VTALRM} = sub { print time, "\n" };
   setitimer(ITIMER_VIRTUAL, 10, 2.5);
 
+  # How accurate we can be, really?
+
+  my $reso = clock_gettime(CLOCK_REALTIME);
+
 =head1 C API
 
 In addition to the perl API described above, a C API is available for
@@ -365,10 +413,15 @@ time as gracefully as UNIX ntp does).  For example in Win32 (and derived
 platforms like Cygwin and MinGW) the Time::HiRes::time() may temporarily
 drift off from the system clock (and the original time())  by up to 0.5
 seconds. Time::HiRes will notice this eventually and recalibrate.
+Note that since Time::HiRes 1.77 the clock_gettime(CLOCK_MONOTONIC)
+might help in this (in case your system supports it).
 
 =head1 SEE ALSO
 
-L<BSD::Resource>, L<Time::TAI64>.
+Perl modules L<BSD::Resource>, L<Time::TAI64>.
+
+Your system documentation for C<clock_gettime>, C<clock_settime>,
+C<gettimeofday>, C<getitimer>, C<setitimer>, C<ualarm>.
 
 =head1 AUTHORS
 
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index dbd6590519..4c56464065 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -30,6 +30,9 @@ extern "C" {
 #  include <sys/select.h>
 # endif
 #endif
+#if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL)
+#include <syscall.h>
+#endif
 #ifdef __cplusplus
 }
 #endif
@@ -739,6 +742,15 @@ nanosleep(nseconds)
 	OUTPUT:
 	RETVAL
 
+#else  /* #if defined(TIME_HIRES_NANOSLEEP) */
+
+NV
+nanosleep(nseconds)
+        NV nseconds
+    CODE:
+        croak("Time::HiRes::nanosleep(): unimplemented in this platform");
+        RETVAL = 0.0;
+
 #endif /* #if defined(TIME_HIRES_NANOSLEEP) */
 
 NV
@@ -778,6 +790,15 @@ sleep(...)
 	OUTPUT:
 	RETVAL
 
+#else  /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
+
+NV
+usleep(useconds)
+        NV useconds
+    CODE:
+        croak("Time::HiRes::usleep(): unimplemented in this platform");
+        RETVAL = 0.0;
+
 #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 
 #ifdef HAS_UALARM
@@ -807,6 +828,24 @@ alarm(seconds,interval=0)
 	OUTPUT:
 	RETVAL
 
+#else
+
+int
+ualarm(useconds,interval=0)
+	int useconds
+	int interval
+    CODE:
+        croak("Time::HiRes::ualarm(): unimplemented in this platform");
+	RETVAL = -1;
+
+NV
+alarm(seconds,interval=0)
+	NV seconds
+	NV interval
+    CODE:
+        croak("Time::HiRes::alarm(): unimplemented in this platform");
+	RETVAL = 0.0;
+
 #endif /* #ifdef HAS_UALARM */
 
 #ifdef HAS_GETTIMEOFDAY
@@ -934,3 +973,63 @@ getitimer(which)
 
 #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
 
+#if defined(TIME_HIRES_CLOCK_GETTIME)
+
+NV
+clock_gettime(clock_id = CLOCK_REALTIME)
+	int clock_id
+    PREINIT:
+	struct timespec ts;
+	int status = -1;
+    CODE:
+#ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL
+	status = syscall(SYS_clock_gettime, clock_id, &ts);
+#else
+	status = clock_gettime(clock_id, &ts);
+#endif
+	RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
+
+    OUTPUT:
+	RETVAL
+
+#else  /* if defined(TIME_HIRES_CLOCK_GETTIME) */
+
+NV
+clock_gettime(clock_id = 0)
+	int clock_id
+    CODE:
+        croak("Time::HiRes::clock_gettime(): unimplemented in this platform");
+        RETVAL = 0.0;
+
+#endif /*  #if defined(TIME_HIRES_CLOCK_GETTIME) */
+
+#if defined(TIME_HIRES_CLOCK_GETRES)
+
+NV
+clock_getres(clock_id = CLOCK_REALTIME)
+	int clock_id
+    PREINIT:
+	int status = -1;
+	struct timespec ts;
+    CODE:
+#ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL
+	status = syscall(SYS_clock_getres, clock_id, &ts);
+#else
+	status = clock_getres(clock_id, &ts);
+#endif
+	RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
+
+    OUTPUT:
+	RETVAL
+
+#else  /* if defined(TIME_HIRES_CLOCK_GETRES) */
+
+NV
+clock_getres(clock_id = 0)
+	int clock_id
+    CODE:
+        croak("Time::HiRes::clock_getres(): unimplemented in this platform");
+        RETVAL = 0.0;
+
+#endif /*  #if defined(TIME_HIRES_CLOCK_GETRES) */
+
diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL
index edc42de67b..bfa65e07cc 100644
--- a/ext/Time/HiRes/Makefile.PL
+++ b/ext/Time/HiRes/Makefile.PL
@@ -15,6 +15,7 @@ my $VERBOSE = $ENV{VERBOSE};
 my $DEFINE;
 my $LIBS = [];
 my $XSOPT = '';
+my $SYSCALL_H;
 
 use vars qw($self); # Used in 'sourcing' the hints.
 
@@ -141,7 +142,7 @@ sub try_compile_and_link {
 	    my $tmp_exe = "$tmp$ld_exeext";
 	    printf "cccmd = $cccmd\n" if $VERBOSE;
 	    my $res = system($cccmd);
-	    $ok = defined($res) && $res==0 && -s $tmp_exe && -x _;
+	    $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _;
 
 	    if ( $ok && exists $args{run} && $args{run}) {
 		my $tmp_exe =
@@ -151,7 +152,14 @@ sub try_compile_and_link {
 		    $ok = 1;
 		} else {
 		    $ok = 0;
-		    print "[ system('$tmp_exe') failed: status $? ] ";
+		    my $errno = $? >> 8;
+		    local $! = $errno;
+		    printf <<EOF;
+
+*** The test run of '$tmp_exe' failed: status $?
+*** (the status means: errno = $errno or '$!')
+*** DO NOT PANIC: this just means that *some* functionality will be missing.
+EOF
 		}
 	    }
 	    unlink("$tmp.c", $tmp_exe);
@@ -241,7 +249,7 @@ int main() {
     ts2.tv_sec  = 0;
     ts2.tv_nsec = 0;
     errno = 0;
-    ret = nanosleep(&ts1, &ts2); /* E.g. in AIX nanosleep() fail and set errno to ENOSYS. */
+    ret = nanosleep(&ts1, &ts2); /* E.g. in AIX nanosleep() fails and sets errno to ENOSYS. */
     ret == 0 ? exit(0) : exit(errno ? errno : -1);
 }
 EOM
@@ -264,6 +272,43 @@ EOM
     return 0;
 }
 
+sub has_clock_x_syscall {
+    my $x = shift;
+    return 0 unless defined $SYSCALL_H;
+    return 1 if
+    try_compile_and_link(<<EOM, run => 1);
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <$SYSCALL_H>
+int main _((int argc, char** argv, char** env))
+{
+    struct timespec ts;
+    /* Many Linuxes get ENOSYS even though the syscall exists. */
+    /* All implementations are supposed to support CLOCK_REALTIME. */
+    int ret = syscall(SYS_clock_$x, CLOCK_REALTIME, &ts);
+    ret == 0 ? exit(0) : exit(errno ? errno : -1);
+}
+EOM
+}
+
+sub has_clock_x {
+    my $x = shift;
+    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))
+{
+    struct timespec ts;
+    int ret = clock_$x(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 init {
     my $hints = File::Spec->catfile("hints", "$^O.pl");
     if (-f $hints) {
@@ -278,6 +323,21 @@ sub init {
 
     $DEFINE = '';
 
+    if ($Config{d_syscall}) {
+	print "Have syscall(), looking for syscall.h... ";
+	if (has_include('syscall.h')) {
+	    $SYSCALL_H = 'syscall.h';
+	} elsif (has_include('sys/syscall.h')) {
+	    $SYSCALL_H = 'sys/syscall.h';
+	}
+    }
+
+    if (defined $SYSCALL_H) {
+	print "found <$SYSCALL_H>.\n";
+    } else {
+	print "NOT found.\n";
+    }
+
     print "Looking for gettimeofday()... ";
     my $has_gettimeofday;
     if (exists $Config{d_gettimeod}) {
@@ -417,6 +477,50 @@ EOD
         print "(It would not be portable anyway.)\n";
     }
 
+    print "Looking for clock_gettime()... ";
+    my $has_clock_gettime;
+    if (exists $Config{d_clock_gettime}) {
+        $has_clock_gettime++ if $Config{d_clock_gettime}; # Unlikely...
+    } elsif (has_clock_x('gettime')) {
+        $has_clock_gettime++;
+	$DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME';
+    } elsif (defined $SYSCALL_H && has_clock_x_syscall('gettime')) {
+        $has_clock_gettime++;
+	$DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_SYSCALL';
+    }
+
+    if ($has_clock_gettime) {
+        if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETTIME_SYSCALL/) {
+	    print "found (via syscall).\n";
+	} else {
+	    print "found.\n";
+	}
+    } else {
+	print "NOT found.\n";
+    }
+
+    print "Looking for clock_getres()... ";
+    my $has_clock_getres;
+    if (exists $Config{d_clock_getres}) {
+        $has_clock_getres++ if $Config{d_clock_getres}; # Unlikely...
+    } elsif (has_clock_x('getres')) {
+        $has_clock_getres++;
+	$DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES';
+    } elsif (defined $SYSCALL_H && has_clock_x_syscall('getres')) {
+        $has_clock_getres++;
+	$DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_SYSCALL';
+    }
+
+    if ($has_clock_getres) {
+        if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETRES_SYSCALL/) {
+	    print "found (via syscall).\n";
+	} else {
+	    print "found.\n";
+	}
+    } else {
+	print "NOT found.\n";
+    }
+
     my $has_w32api_windows_h;
     if ($^O eq 'cygwin') {
         print "Looking for <w32api/windows.h>... ";
@@ -457,7 +561,8 @@ sub doMakefile {
 	'LIBS'	=> $LIBS,   # e.g., '-lm'
 	'DEFINE'	=> $DEFINE,     # e.g., '-DHAS_SOMETHING'
 	'XSOPT'	=> $XSOPT,
-    # do not even think about 'INC' => '-I/usr/ucbinclude', Solaris will avenge.
+	  # Do not even think about 'INC' => '-I/usr/ucbinclude',
+	  # Solaris will avenge.
 	'INC'	=> '',     # e.g., '-I/usr/include/other'
 	'INSTALLDIRS' => ($] >= 5.008 ? 'perl' : 'site'),
 	'dist'      => {
@@ -478,12 +583,17 @@ sub doMakefile {
 
 sub doConstants {
     if (eval {require ExtUtils::Constant; 1}) {
-	my @names = (qw(ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
+	my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC
+			CLOCK_PROCESS_CPUTIME_ID
+			CLOCK_REALTIME
+			CLOCK_THREAD_CPUTIME_ID
+			CLOCK_TIMEOFDAY
+			ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
 			ITIMER_REALPROF));
 	foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
-		     d_nanosleep)) {
+		     d_nanosleep d_clock_gettime d_clock_getres)) {
 	    my $macro = $_;
-	    if ($macro eq 'd_nanosleep') {
+	    if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres)$/) {
 		$macro =~ s/d_(.*)/TIME_HIRES_\U$1/;
 	    } else {
 		$macro =~ s/d_(.*)/HAS_\U$1/;
@@ -532,7 +642,7 @@ EOM
            (exists $ENV{LC_CTYPE} && $ENV{LC_CTYPE} =~ /utf-?8/i) ||
            (exists $ENV{LANG}     && $ENV{LANG}     =~ /utf-?8/i)) {
             print  <<EOM;
-NOTE: if you get an error like this (the line number may vary):
+NOTE: if you get an error like this (the Makefile line number may vary):
 Makefile:91: *** missing separator
 then set the environment variable LC_ALL to "C" and retry
 from scratch (re-run perl "Makefile.PL").
diff --git a/ext/Time/HiRes/fallback/const-c.inc b/ext/Time/HiRes/fallback/const-c.inc
index 77b137f632..6038faafa2 100644
--- a/ext/Time/HiRes/fallback/const-c.inc
+++ b/ext/Time/HiRes/fallback/const-c.inc
@@ -19,7 +19,6 @@ 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
@@ -74,7 +73,120 @@ constant_11 (pTHX_ const char *name, IV *iv_return) {
   case 'l':
     if (memEQ(name, "d_nanosleep", 11)) {
     /*                      ^          */
-#ifdef HAS_NANOSLEEP
+#ifdef TIME_HIRES_NANOSLEEP
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+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':
+    if (memEQ(name, "CLOCK_REALTIME", 14)) {
+    /*                     ^              */
+#ifdef CLOCK_REALTIME
+      *iv_return = CLOCK_REALTIME;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '_':
+    if (memEQ(name, "ITIMER_VIRTUAL", 14)) {
+    /*                     ^              */
+#ifdef ITIMER_VIRTUAL
+      *iv_return = ITIMER_VIRTUAL;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'i':
+    if (memEQ(name, "d_gettimeofday", 14)) {
+    /*                     ^              */
+#ifdef HAS_GETTIMEOFDAY
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
+  case 'k':
+    if (memEQ(name, "d_clock_getres", 14)) {
+    /*                     ^              */
+#ifdef TIME_HIRES_CLOCK_GETRES
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_15 (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_MONOTONIC CLOCK_TIMEOFDAY ITIMER_REALPROF d_clock_gettime */
+  /* Offset 7 gives the best switch position.  */
+  switch (name[7]) {
+  case 'I':
+    if (memEQ(name, "CLOCK_TIMEOFDAY", 15)) {
+    /*                      ^              */
+#ifdef CLOCK_TIMEOFDAY
+      *iv_return = CLOCK_TIMEOFDAY;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'O':
+    if (memEQ(name, "CLOCK_MONOTONIC", 15)) {
+    /*                      ^              */
+#ifdef CLOCK_MONOTONIC
+      *iv_return = CLOCK_MONOTONIC;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'R':
+    if (memEQ(name, "ITIMER_REALPROF", 15)) {
+    /*                      ^              */
+#ifdef ITIMER_REALPROF
+      *iv_return = ITIMER_REALPROF;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '_':
+    if (memEQ(name, "d_clock_gettime", 15)) {
+    /*                      ^              */
+#ifdef TIME_HIRES_CLOCK_GETTIME
       *iv_return = 1;
       return PERL_constant_ISIV;
 #else
@@ -100,14 +212,18 @@ constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
      Regenerate these constant functions by feeding this entire source file to
      perl -x
 
-#!/usr/local/bin/perl5.8.0 -w
+#!perl -w
 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
 
 my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(ITIMER_PROF ITIMER_REAL ITIMER_REALPROF ITIMER_VIRTUAL),
+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),
+            {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_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=>"HAS_NANOSLEEP", value=>"1", default=>["IV", "0"]},
+            {name=>"d_nanosleep", type=>"IV", macro=>"TIME_HIRES_NANOSLEEP", value=>"1", default=>["IV", "0"]},
             {name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]},
             {name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]},
             {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]});
@@ -128,8 +244,8 @@ __END__
     /* Offset 7 gives the best switch position.  */
     switch (name[7]) {
     case 'm':
-      if (memEQ(name, "d_ualarm", 8)) {
-      /*                      ^      */
+      if (memEQ(name, "d_ualar", 7)) {
+      /*                      m     */
 #ifdef HAS_UALARM
         *iv_return = 1;
         return PERL_constant_ISIV;
@@ -140,8 +256,8 @@ __END__
       }
       break;
     case 'p':
-      if (memEQ(name, "d_usleep", 8)) {
-      /*                      ^      */
+      if (memEQ(name, "d_uslee", 7)) {
+      /*                      p     */
 #ifdef HAS_USLEEP
         *iv_return = 1;
         return PERL_constant_ISIV;
@@ -156,40 +272,36 @@ __END__
   case 11:
     return constant_11 (aTHX_ name, iv_return);
     break;
-  case 14:
-    /* Names all of length 14.  */
-    /* ITIMER_VIRTUAL d_gettimeofday */
-    /* Offset 6 gives the best switch position.  */
-    switch (name[6]) {
-    case '_':
-      if (memEQ(name, "ITIMER_VIRTUAL", 14)) {
-      /*                     ^              */
-#ifdef ITIMER_VIRTUAL
-        *iv_return = ITIMER_VIRTUAL;
-        return PERL_constant_ISIV;
+  case 13:
+    if (memEQ(name, "CLOCK_HIGHRES", 13)) {
+#ifdef CLOCK_HIGHRES
+      *iv_return = CLOCK_HIGHRES;
+      return PERL_constant_ISIV;
 #else
-        return PERL_constant_NOTDEF;
+      return PERL_constant_NOTDEF;
 #endif
-      }
-      break;
-    case 'i':
-      if (memEQ(name, "d_gettimeofday", 14)) {
-      /*                     ^              */
-#ifdef HAS_GETTIMEOFDAY
-        *iv_return = 1;
-        return PERL_constant_ISIV;
+    }
+    break;
+  case 14:
+    return constant_14 (aTHX_ name, iv_return);
+    break;
+  case 15:
+    return constant_15 (aTHX_ name, iv_return);
+    break;
+  case 23:
+    if (memEQ(name, "CLOCK_THREAD_CPUTIME_ID", 23)) {
+#ifdef CLOCK_THREAD_CPUTIME_ID
+      *iv_return = CLOCK_THREAD_CPUTIME_ID;
+      return PERL_constant_ISIV;
 #else
-        *iv_return = 0;
-        return PERL_constant_ISIV;
+      return PERL_constant_NOTDEF;
 #endif
-      }
-      break;
     }
     break;
-  case 15:
-    if (memEQ(name, "ITIMER_REALPROF", 15)) {
-#ifdef ITIMER_REALPROF
-      *iv_return = ITIMER_REALPROF;
+  case 24:
+    if (memEQ(name, "CLOCK_PROCESS_CPUTIME_ID", 24)) {
+#ifdef CLOCK_PROCESS_CPUTIME_ID
+      *iv_return = CLOCK_PROCESS_CPUTIME_ID;
       return PERL_constant_ISIV;
 #else
       return PERL_constant_NOTDEF;
diff --git a/ext/Time/HiRes/fallback/const-xs.inc b/ext/Time/HiRes/fallback/const-xs.inc
index c84dd051dd..9412046aa9 100644
--- a/ext/Time/HiRes/fallback/const-xs.inc
+++ b/ext/Time/HiRes/fallback/const-xs.inc
@@ -86,3 +86,4 @@ constant(sv)
                type, s));
           PUSHs(sv);
         }
+
diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t
index e7d383cd04..93af2c6c54 100644
--- a/ext/Time/HiRes/t/HiRes.t
+++ b/ext/Time/HiRes/t/HiRes.t
@@ -12,7 +12,7 @@ BEGIN {
     }
 }
 
-BEGIN { $| = 1; print "1..29\n"; }
+BEGIN { $| = 1; print "1..31\n"; }
 
 END { print "not ok 1\n" unless $loaded }
 
@@ -24,22 +24,26 @@ print "ok 1\n";
 
 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;
+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;
 
-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_time         = %d\n", $have_time;
+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;
 
 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;
+import Time::HiRes 'clock_gettime'	if $have_clock_gettime;
+import Time::HiRes 'clock_getres'	if $have_clock_getres;
 
 use Config;
 
@@ -192,7 +196,7 @@ else {
 
 # Did we even get close?
 
-unless ($have_time) {
+unless ($have_gettimeofday) {
     skip 14;
 } else {
  my ($s, $n, $i) = (0);
@@ -218,7 +222,7 @@ unless (   defined &Time::HiRes::gettimeofday
 	print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n";
     }
 } else {
-    use Time::HiRes qw (time alarm sleep);
+    use Time::HiRes qw(time alarm sleep);
 
     my ($f, $r, $i, $not, $ok);
 
@@ -281,7 +285,7 @@ unless (   defined &Time::HiRes::gettimeofday
 
 unless (   defined &Time::HiRes::setitimer
 	&& defined &Time::HiRes::getitimer
-	&& eval    'Time::HiRes::ITIMER_VIRTUAL'
+        && exists  &Time::HiRes::ITIMER_VIRTUAL
 	&& $Config{d_select}
 	&& $Config{sig_name} =~ m/\bVTALRM\b/) {
     for (18..19) {
@@ -414,15 +418,107 @@ if ($have_nanosleep) {
 if ($have_ualarm && $] >= 5.008001) {
     # http://groups.google.com/group/perl.perl5.porters/browse_thread/thread/adaffaaf939b042e/20dafc298df737f0%2320dafc298df737f0?sa=X&oi=groupsr&start=0&num=3
     # Perl changes [18765] and [18770], perl bug [perl #20920]
+
+    # First we will find the loop size N (a for() loop 0..N-1)
+    # that will take more than T seconds.
+
+    my $T = 0.01;
+    use Time::HiRes qw(time);
+    my $N = 1024;
+    my $i;
+    N: {
+	do {
+	    my $t0 = time();
+	    for ($i = 0; $i < $N; $i++) { }
+	    my $t1 = time();
+	    my $dt = $t1 - $t0;
+	    print "# N = $N, t1 = $t1, t0 = $t0, dt = $dt\n";
+	    last N if $dt > $T;
+	    $N *= 2;
+	} while (1);
+    }
+
+    # The time-burner which takes at least T seconds.
+    my $F = sub {
+	my $c = @_ ? shift : 1;
+	my $n = $c * $N;
+	my $i;
+	for ($i = 0; $i < $n; $i++) { }
+    };
+
+    # Then we will setup a periodic timer (the two-argument alarm() of
+    # Time::HiRes, behind the curtains the libc ualarm()) which has
+    # a signal handler that takes so much time (on the first initial
+    # invocation) that the first periodic invocation (second invocation)
+    # will happen before the first invocation has finished.  In Perl 5.8.0
+    # the "safe signals" concept was implemented, with unfortunately at least
+    # one bug that caused a core dump on reentering the handler. This bug
+    # was fixed by the time of Perl 5.8.1.
+
+    my $a = 0; # Number of alarms we receive.
+    my $A = 2; # Number of alarms we will handle before disarming.
+               # (We may well get $A + 1 alarms.)
+
+    $SIG{ALRM} = sub {
+	$a++;
+	print "# Alarm $a - ", time(), "\n";
+	alarm(0) if $a >= $A; # Disarm the alarm.
+	$F->(2); # Try burning CPU at least for 2T seconds.
+    }; 
+
     use Time::HiRes qw(alarm); 
-    $SIG{ALRM} = sub { 1 for 1..100000 }; 
-    alarm(0.01, 0.01); 
-    sleep(1);
+    alarm($T, $T);  # Arm the alarm.
+
+    $F->(10); # Try burning CPU at least for 10T seconds.
+
     print "ok 29\n"; # Not core dumping by now is considered to be the success.
 } else {
     skip 29;
 }
 
+if ($have_clock_gettime) {
+    # All implementations are SUPPOSED TO support CLOCK_REALTIME...
+    eval 'use Time::HiRes qw(CLOCK_REALTIME)';
+    unless ($@) {
+        my $t0 = clock_gettime(&CLOCK_REALTIME);
+        use Time::HiRes qw(sleep);
+        my $T = 0.1;
+        sleep($T);
+        my $t1 = clock_gettime(&CLOCK_REALTIME);
+	if ($t0 > 0 && $t1) {
+	    print "# t1 = $t1, t0 = $t0\n";
+	    my $dt = $t1 - $t0;
+	    my $rt = abs(1 - $dt / $T);
+	    if ($rt <= 0.25) { # Allow 25% jitter.
+		print "ok 30 # dt = $dt, r = $rt\n";
+	    } else {
+		print "not ok 30 # dt = $dt, rt = $rt\n";
+	    }
+	} else {
+	    print "# Error '$!'\n";
+	    skip 30;
+	}
+    } else {
+        print "# No CLOCK_REALTIME ($@)\n";
+	skip 30;
+    }
+} else {
+    print "# No clock_gettime\n";
+    skip 30;
+}
+
+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";
+   }
+} else {
+    print "# No clock_getres\n";
+    skip 31;
+}
+
 END {
     if (defined $timer_pid) {
 	print "# I am the main process $$, terminating the timer process $timer_pid.\n";