From a8fb48f7d682d4a043c30ec3ec06da197a6845f4 Mon Sep 17 00:00:00 2001 From: Steve Peters Date: Wed, 7 Feb 2007 14:56:05 +0000 Subject: [PATCH] Upgrade to Time-HiRes-1.9705 p4raw-id: //depot/perl@30157 --- MANIFEST | 1 + ext/Time/HiRes/Changes | 6 ++++ ext/Time/HiRes/HiRes.pm | 12 ++++---- ext/Time/HiRes/HiRes.xs | 68 ++++++++++++++++++++----------------------- ext/Time/HiRes/Makefile.PL | 29 +++++++++++------- ext/Time/HiRes/hints/linux.pl | 2 ++ ext/Time/HiRes/t/HiRes.t | 2 +- 7 files changed, 66 insertions(+), 54 deletions(-) create mode 100644 ext/Time/HiRes/hints/linux.pl diff --git a/MANIFEST b/MANIFEST index a795818..d671ac0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1172,6 +1172,7 @@ ext/Time/HiRes/hints/aix.pl Hint for Time::HiRes for named architecture ext/Time/HiRes/hints/dec_osf.pl Hint for Time::HiRes for named architecture ext/Time/HiRes/hints/dynixptx.pl Hint for Time::HiRes for named architecture ext/Time/HiRes/hints/irix.pl Hint for Time::HiRes for named architecture +ext/Time/HiRes/hints/linux.pl Hints for Time::HiRes for named architecture ext/Time/HiRes/hints/sco.pl Hints for Time::HiRes for named architecture ext/Time/HiRes/hints/solaris.pl Hints for Time::HiRes for named architecture ext/Time/HiRes/hints/svr4.pl Hints for Time::HiRes for named architecture diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index dc4fe51..cebc812 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,5 +1,11 @@ Revision history for the Perl extension Time::HiRes. +1.9705 [2007-02-06] + - nanosleep() and clock_nanosleep() detection and use were + quite broken; in Linux -lrt needed; fixes from Zefram + - [internal] slightly cleaner building of $DEFINE in Makefile.PL, + should avoid double/conflicting -D flags + 1.9704 [2007-01-01] - allow 10% of slop in test #14 (testing difference between CORE::time() and Time::HiRes::time()), there seem to be often diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index b666341..7d31760 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -23,7 +23,7 @@ require DynaLoader; stat ); -$VERSION = '1.9704'; +$VERSION = '1.9705'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -119,8 +119,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers $realtime = clock_gettime(CLOCK_REALTIME); $resolution = clock_getres(CLOCK_REALTIME); - clock_nanosleep(CLOCK_REALTIME, 1.5); - clock_nanosleep(CLOCK_REALTIME, time() + 10, TIMER_ABSTIME); + clock_nanosleep(CLOCK_REALTIME, 1.5e9); + clock_nanosleep(CLOCK_REALTIME, time()*1e9 + 10e9, TIMER_ABSTIME); my $ticktock = clock(); @@ -347,10 +347,10 @@ specified by C<$which>. All implementations that support POSIX high resolution timers are supposed to support at least the C<$which> value of C, see L. -=item clock_nanosleep ( $which, $seconds, $flags = 0) +=item clock_nanosleep ( $which, $nanoseconds, $flags = 0) -Sleeps for the number of seconds (1e9ths of a second) specified. -Returns the number of seconds actually slept. The $which is the +Sleeps for the number of nanoseconds (1e9ths of a second) specified. +Returns the number of nanoseconds actually slept. The $which is the "clock id", as with clock_gettime() and clock_getres(). The flags default to zero but C can specified (must be exported explicitly) which means that C<$nanoseconds> is not a time interval diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index fcf93bb..731df21 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -817,31 +817,24 @@ NV nanosleep(nsec) NV nsec PREINIT: - int status = -1; - struct timeval Ta, Tb; + struct timespec sleepfor, unslept; CODE: - gettimeofday(&Ta, NULL); - if (items > 0) { - struct timespec ts1; - if (nsec > 1E9) { - IV sec = (IV) (nsec / 1E9); - if (sec) { - sleep(sec); - nsec -= 1E9 * sec; - } - } else if (nsec < 0.0) - croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec); - ts1.tv_sec = (IV) (nsec / 1E9); - ts1.tv_nsec = (IV) nsec - (IV) (ts1.tv_sec * NV_1E9); - status = nanosleep(&ts1, NULL); + if (nsec < 0.0) + croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec); + sleepfor.tv_sec = nsec / 1e9; + sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9; + if (!nanosleep(&sleepfor, &unslept)) { + RETVAL = nsec; } else { - PerlProc_pause(); - status = 0; + sleepfor.tv_sec -= unslept.tv_sec; + sleepfor.tv_nsec -= unslept.tv_nsec; + if (sleepfor.tv_nsec < 0) { + sleepfor.tv_sec--; + sleepfor.tv_nsec += 1000000000; + } + RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec); } - gettimeofday(&Tb, NULL); - RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1; - - OUTPUT: + OUTPUT: RETVAL #else /* #if defined(TIME_HIRES_NANOSLEEP) */ @@ -1145,27 +1138,28 @@ clock_getres(clock_id = 0) #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) NV -clock_nanosleep(clock_id = CLOCK_REALTIME, sec = 0.0, flags = 0) +clock_nanosleep(clock_id, nsec, flags = 0) int clock_id - NV sec + NV nsec int flags PREINIT: - int status = -1; - struct timespec ts; - struct timeval Ta, Tb; + struct timespec sleepfor, unslept; CODE: - gettimeofday(&Ta, NULL); - if (items > 1) { - ts.tv_sec = (IV) sec; - ts.tv_nsec = (sec - (NV) ts.tv_sec) * (NV) 1E9; - status = clock_nanosleep(clock_id, flags, &ts, NULL); + if (nsec < 0.0) + croak("Time::HiRes::clock_nanosleep(..., %"NVgf"): negative time not invented yet", nsec); + sleepfor.tv_sec = nsec / 1e9; + sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9; + if (!clock_nanosleep(clock_id, flags, &sleepfor, &unslept)) { + RETVAL = nsec; } else { - PerlProc_pause(); - status = 0; + sleepfor.tv_sec -= unslept.tv_sec; + sleepfor.tv_nsec -= unslept.tv_nsec; + if (sleepfor.tv_nsec < 0) { + sleepfor.tv_sec--; + sleepfor.tv_nsec += 1000000000; + } + RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec); } - gettimeofday(&Tb, NULL); - RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1; - OUTPUT: RETVAL diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index b9888ea..cc725b2 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -342,11 +342,12 @@ sub has_clock_nanosleep { #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include int main(int argc, char** argv) { int ret; - struct timerspec ts1; - struct timerspec ts2; + struct timespec ts1; + struct timespec ts2; ts1.tv_sec = 0; ts1.tv_nsec = 750000000;; ret = clock_nanosleep(CLOCK_MONOTONIC, 0, &ts1, &ts2); @@ -355,6 +356,14 @@ int main(int argc, char** argv) EOM } +sub DEFINE { + my ($def, $val) = @_; + my $define = defined $val ? "$def=$val" : $def ; + unless ($DEFINE =~ /(?:^| )-D\Q$define\E(?: |$)/) { + $DEFINE .= " -D$define"; + } +} + sub init { my $hints = File::Spec->catfile("hints", "$^O.pl"); if (-f $hints) { @@ -614,7 +623,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtimespec++; - $DEFINE .= ' -DTIME_HIRES_STAT=1'; + DEFINE('TIME_HIRES_STAT', 1); } if ($has_stat_st_xtimespec) { @@ -634,7 +643,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtimensec++; - $DEFINE .= ' -DTIME_HIRES_STAT=2'; + DEFINE('TIME_HIRES_STAT', 2); } if ($has_stat_st_xtimensec) { @@ -654,7 +663,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtime_n++; - $DEFINE .= ' -DTIME_HIRES_STAT=3'; + DEFINE('TIME_HIRES_STAT', 3); } if ($has_stat_st_xtime_n) { @@ -674,7 +683,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_xtim++; - $DEFINE .= ' -DTIME_HIRES_STAT=4'; + DEFINE('TIME_HIRES_STAT', 4); } if ($has_stat_st_xtim) { @@ -694,7 +703,7 @@ int main(int argc, char** argv) { } EOM $has_stat_st_uxtime++; - $DEFINE .= ' -DTIME_HIRES_STAT=5'; + DEFINE('TIME_HIRES_STAT', 5); } if ($has_stat_st_uxtime) { @@ -716,7 +725,7 @@ EOM print "Looking for ... "; if (has_include('w32api/windows.h')) { $has_w32api_windows_h++; - $DEFINE .= ' -DHAS_W32API_WINDOWS_H'; + DEFINE('HAS_W32API_WINDOWS_H'); } if ($has_w32api_windows_h) { print "found.\n"; @@ -742,7 +751,7 @@ sub doMakefile { 'AUTHOR' => 'Jarkko Hietaniemi ', 'ABSTRACT_FROM' => 'HiRes.pm', ); - $DEFINE .= " -DATLEASTFIVEOHOHFIVE"; + DEFINE('ATLEASTFIVEOHOHFIVE'); } push (@makefileopts, @@ -826,7 +835,7 @@ sub main { } if ($^O =~ /Win32/i) { - $DEFINE = '-DSELECT_IS_BROKEN'; + DEFINE('SELECT_IS_BROKEN'); $LIBS = []; print "System is $^O, skipping full configure...\n"; } else { diff --git a/ext/Time/HiRes/hints/linux.pl b/ext/Time/HiRes/hints/linux.pl new file mode 100644 index 0000000..84ce522 --- /dev/null +++ b/ext/Time/HiRes/hints/linux.pl @@ -0,0 +1,2 @@ +# needs to explicitly link against librt to pull in clock_nanosleep +$self->{LIBS} = ['-lrt']; diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index 3be8d3c..d9c5739 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -560,7 +560,7 @@ if ($have_clock_getres) { if ($have_clock_nanosleep && has_symbol('CLOCK_REALTIME')) { - my $s = 1.5; + my $s = 1.5e9; my $t = clock_nanosleep(&CLOCK_REALTIME, $s); my $r = abs(1 - $t / $s); if ($r < 2 * $limit) { -- 2.7.4