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.
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
- 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)
- 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
@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;
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");
}
=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);
$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
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.
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.
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
# 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
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) */
#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
#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;
#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) */
+
return 0;
}
-sub has_clock_x_syscall {
+sub has_clock_xxx_syscall {
my $x = shift;
return 0 unless defined $SYSCALL_H;
return 1 if
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"
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) {
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';
}
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';
}
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')) {
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/;
#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
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;
#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;
#endif
}
break;
- case 'i':
+ case 'e':
if (memEQ(name, "d_gettimeofday", 14)) {
- /* ^ */
+ /* ^ */
#ifdef HAS_GETTIMEOFDAY
*iv_return = 1;
return PERL_constant_ISIV;
#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;
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"]},
*/
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 */
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:
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
type, s));
PUSHs(sv);
}
-
}
}
-BEGIN { $| = 1; print "1..31\n"; }
+BEGIN { $| = 1; print "1..33\n"; }
END { print "not ok 1\n" unless $loaded }
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;
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;
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;
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);
}
}
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();
projects / p5sagit/p5-mst-13.2.git / commitdiff