From: Steve Peters Date: Sat, 17 Dec 2005 01:46:58 +0000 (+0000) Subject: Upgrade to Time-HiRes-1.85 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=170c5524f26ec8d57d5b2a5413842df92809a613;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Time-HiRes-1.85 p4raw-id: //depot/perl@26383 --- diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index b61607f..1c78b96 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -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 . 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 diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 2b4269f..d8a1832 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -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 module implements a Perl interface to the @@ -156,8 +166,10 @@ seconds like C (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 system call. See -also C and C. +sleep for more than one second, unlike the C system call. Can +also sleep for zero seconds, which often works like a I. +See also C, C, and +C. 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 and -C. +one second. Can also sleep for zero seconds, which often works like a +I. See also C, +C, and C. 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, see L. +of C, see L. + +=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 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. See also C, +C, and C. + +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 (user + system time) spent by +the process since the first call to clock() (the definition is B +"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, see L. # 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 diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index d4d1304..8883be8 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -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) */ + diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index bce235e..5e54b49 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -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(< 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(< 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(< 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 ... "; 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/; diff --git a/ext/Time/HiRes/fallback/const-c.inc b/ext/Time/HiRes/fallback/const-c.inc index 6038faa..86028f1 100644 --- a/ext/Time/HiRes/fallback/const-c.inc +++ b/ext/Time/HiRes/fallback/const-c.inc @@ -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 diff --git a/ext/Time/HiRes/fallback/const-xs.inc b/ext/Time/HiRes/fallback/const-xs.inc index 9412046..c84dd05 100644 --- a/ext/Time/HiRes/fallback/const-xs.inc +++ b/ext/Time/HiRes/fallback/const-xs.inc @@ -86,4 +86,3 @@ constant(sv) type, s)); PUSHs(sv); } - diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index ad4959e..b0969f0 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -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();