From: Steve Peters Date: Fri, 13 Oct 2006 14:11:04 +0000 (+0000) Subject: Upgrade to Time-HiRes-1.92. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=75d5269bea18b708512b900d3a2ed5a9bb5ba05a;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Time-HiRes-1.92. p4raw-id: //depot/perl@29010 --- diff --git a/MANIFEST b/MANIFEST index 1a4b163..3a2cbb5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1168,6 +1168,7 @@ ext/Thread/unsync.tx Test thread implicit synchronisation ext/Time/HiRes/Changes Time::HiRes extension ext/Time/HiRes/fallback/const-c.inc Time::HiRes extension ext/Time/HiRes/fallback/const-xs.inc Time::HiRes extension +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 diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes index b878c28..07aed02 100644 --- a/ext/Time/HiRes/Changes +++ b/ext/Time/HiRes/Changes @@ -1,11 +1,51 @@ -Revision history for Perl extension Time::HiRes. +Revision history for the Perl extension Time::HiRes. -1.91 [2006-09-28] +1.92 [2006-10-13] + - scan for subsecond resolution timestamps in struct stat, + some known possibilities: + + (1) struct timespec st_atimespec; + st_atimespec.tv_nsec; + (2) time_t st_atime; + long st_atimensec; + (3) time_t st_atime; + int st_atime_n; + (4) timestruc_t st_atim; + st_atim.tv_nsec + (5) time_t st_atime; + int st_uatime; + + If something like this is found, one can do + + use Time::HiRes; + my @stat = Time::HiRes::stat(); + + or even override the standard stat(): + + use Time::HiRes qw(stat); + + to get the stat() timestamps + + my ($atime, $mtime, $ctime) = @stat[8, 9, 10]; + + with subsecond resolution (assuming both the operating + system and the filesystem support that kind of thing). + + Contributions for more systems (especially non-UNIX, + e.g. but not limited to, Win32, VMS) gladly accepted. + + Thanks to H.Merijn Brand, John Peacock, and Craig + Berry for brave beta testing. + +1.91 [2006-09-29] - ualarm() in SuSE 10.1 was overflowing after ~4.2 seconds, - probably due to a glibc bug/feature, workaround by using the - setitimer() variant if either useconds or interval >= IV_1E6 - (this case seems to vary between systems: are useconds - more than 999_999 for ualarm() defined or not) + possibly due to a glibc bug/feature, workaround by using the + setitimer() implementation of ualarm() if either useconds or + interval > 999_999 (this case seems to vary between systems: + are useconds more than 999_999 for ualarm() defined or not) + Added more ualarm() tests to catch various overflow points, + hopefully no problems in various platforms. + (The problem report by Mark Seger and Jon Paul Sullivan of HP.) 1.90 [2006-08-22] - tweak still needed for Const64(), from Jerry Hedden @@ -16,7 +56,8 @@ Revision history for Perl extension Time::HiRes. - Const64() already appends an 'LL' (or i64), so provide LL and i64 forms for the IV_1E[679] (effects Win32 and Cygwin), reported by Jerry Hedden. - - the Changes entry for 1.88 talked about [IN]V_1[679], missing the 'E'. + - the Changes entry for 1.88 talked about [IN]V_1[679], + missing the 'E'. 1.88 [2006-08-21] - clean up the g++ warnings in HiRes.xs, all of them diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index b975262..1824183 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -19,9 +19,11 @@ require DynaLoader; TIMER_ABSTIME d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep d_clock_gettime d_clock_getres - d_clock d_clock_nanosleep); + d_clock d_clock_nanosleep + stat + ); -$VERSION = '1.91'; +$VERSION = '1.92'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -83,7 +85,8 @@ 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_nanosleep clock ); + clock_gettime clock_getres clock_nanosleep clock + stat ); usleep ($microseconds); nanosleep ($nanoseconds); @@ -119,6 +122,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers my $ticktock = clock(); + my @stat = stat(FH); + =head1 DESCRIPTION The C module implements a Perl interface to the @@ -357,6 +362,31 @@ but not necessarily identical. Note that due to backward compatibility limitations the returned value may wrap around at about 2147 seconds or at about 36 minutes. +=item stat + +=item stat FH + +=item stat EXPR + +As L but with the access/modify/change file timestamps +in subsecond resolution, if the operating system and the filesystem +both support such timestamps. To override the standard stat(): + + use Time::HiRes qw(stat); + +Test for the value of &Time::HiRes::d_hires_stat to find out whether +the operating system supports subsecond file timestamps: a value +larger than zero means yes. There are unfortunately no easy +ways to find out whether the filesystem supports such timestamps. + +A zero return value of &Time::HiRes::d_hires_stat means that +Time::HiRes::stat is a no-op passthrough for CORE::stat(), +and therefore the timestamps will stay integers. The same +will happen if the filesystem does not do subsecond timestamps. + +In any case do not expect nanosecond resolution, or even a microsecond +resolution. + =back =head1 EXAMPLES diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index c27c563..f1029f0 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -479,6 +479,13 @@ hrt_ualarm_itimer(int usec, int interval) itv.it_interval.tv_usec = interval % IV_1E6; return setitimer(ITIMER_REAL, &itv, 0); } +#ifdef HAS_UALARM +int +hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */ +{ + return hrt_ualarm_itimer(usec, interval); +} +#endif /* #ifdef HAS_UALARM */ #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */ #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) @@ -710,6 +717,42 @@ myNVtime() #endif /* #ifdef HAS_GETTIMEOFDAY */ +static void +hrstatns(UV atime, UV mtime, UV ctime, UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) +{ + dTHX; + *atime_nsec = 0; + *mtime_nsec = 0; + *ctime_nsec = 0; +#ifdef TIME_HIRES_STAT +#if TIME_HIRES_STAT == 1 + *atime_nsec = PL_statcache.st_atimespec.tv_nsec; + *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec; + *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec; +#endif +#if TIME_HIRES_STAT == 2 + *atime_nsec = PL_statcache.st_atimensec; + *mtime_nsec = PL_statcache.st_mtimensec; + *ctime_nsec = PL_statcache.st_ctimensec; +#endif +#if TIME_HIRES_STAT == 3 + *atime_nsec = PL_statcache.st_atime_n; + *mtime_nsec = PL_statcache.st_mtime_n; + *ctime_nsec = PL_statcache.st_ctime_n; +#endif +#if TIME_HIRES_STAT == 4 + *atime_nsec = PL_statcache.st_atim.tv_nsec; + *mtime_nsec = PL_statcache.st_mtim.tv_nsec; + *ctime_nsec = PL_statcache.st_ctim.tv_nsec; +#endif +#if TIME_HIRES_STAT == 5 + *atime_nsec = PL_statcache.st_uatime * 1000; + *mtime_nsec = PL_statcache.st_umtime * 1000; + *ctime_nsec = PL_statcache.st_uctime * 1000; +#endif +#endif +} + #include "const-c.inc" MODULE = Time::HiRes PACKAGE = Time::HiRes @@ -1166,3 +1209,34 @@ clock() #endif /* #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */ +IV +stat(...) +PROTOTYPE: ;$ + PPCODE: + PUSHMARK(SP); + XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV))); + PUTBACK; + ENTER; + PL_laststatval = -1; + (void)*(PL_ppaddr[OP_STAT])(aTHX); + SPAGAIN; + LEAVE; + if (PL_laststatval == 0) { + /* We assume that pp_stat() left us with 13 valid stack items. */ + UV atime = SvUV(ST( 8)); + UV mtime = SvUV(ST( 9)); + UV ctime = SvUV(ST(10)); + UV atime_nsec; + UV mtime_nsec; + UV ctime_nsec; + hrstatns(atime, mtime, ctime, + &atime_nsec, &mtime_nsec, &ctime_nsec); + if (atime_nsec) + ST( 8) = sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec)); + if (mtime_nsec) + ST( 9) = sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec)); + if (ctime_nsec) + ST(10) = sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec)); + XSRETURN(13); + } + XSRETURN(0); diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL index 5e54b49..115cea3 100644 --- a/ext/Time/HiRes/Makefile.PL +++ b/ext/Time/HiRes/Makefile.PL @@ -169,24 +169,26 @@ EOF return $ok; } -sub has_gettimeofday { - # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already) - return 0 if $Config{d_gettimeod}; - return 1 if try_compile_and_link(< #endif - #ifdef I_SYS_TIME # include #endif - #ifdef I_SYS_SELECT # include /* struct timeval might be hidden in here */ #endif +EOH + +sub has_gettimeofday { + # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already) + return 0 if $Config{d_gettimeod}; + return 1 if try_compile_and_link(< +int main() { + struct stat st; + st.st_atimespec.tv_nsec = 0; +} +EOM + $has_stat_st_xtimespec++; + $DEFINE .= ' -DTIME_HIRES_STAT=1'; + } + + if ($has_stat_st_xtimespec) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + print "Trying struct stat st_atimensec..."; + my $has_stat_st_xtimensec; + if (try_compile_and_link(< +int main() { + struct stat st; + st.st_atimensec = 0; +} +EOM + $has_stat_st_xtimensec++; + $DEFINE .= ' -DTIME_HIRES_STAT=2'; + } + + if ($has_stat_st_xtimensec) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + print "Trying struct stat st_atime_n..."; + my $has_stat_st_xtime_n; + if (try_compile_and_link(< +int main() { + struct stat st; + st.st_atime_n = 0; +} +EOM + $has_stat_st_xtime_n++; + $DEFINE .= ' -DTIME_HIRES_STAT=3'; + } + + if ($has_stat_st_xtime_n) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + print "Trying struct stat st_atim.tv_nsec..."; + my $has_stat_st_xtim; + if (try_compile_and_link(< +int main() { + struct stat st; + st.st_atim.tv_nsec = 0; +} +EOM + $has_stat_st_xtim++; + $DEFINE .= ' -DTIME_HIRES_STAT=4'; + } + + if ($has_stat_st_xtim) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + print "Trying struct stat st_uatime..."; + my $has_stat_st_uxtime; + if (try_compile_and_link(< +int main() { + struct stat st; + st.st_uatime = 0; +} +EOM + $has_stat_st_uxtime++; + $DEFINE .= ' -DTIME_HIRES_STAT=5'; + } + + if ($has_stat_st_uxtime) { + print "found.\n"; + } else { + print "NOT found.\n"; + } + + if ($DEFINE =~ /-DTIME_HIRES_STAT=\d+/) { + print "You seem to have stat subsecond timestamps.\n"; + print "(Your struct stat has them, but the filesystems must help.)\n"; + } else { + print "You do not seem to have stat subsecond timestamps.\n"; + } + my $has_w32api_windows_h; if ($^O eq 'cygwin') { @@ -652,22 +761,28 @@ sub doMakefile { sub doConstants { if (eval {require ExtUtils::Constant; 1}) { - 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 - TIMER_ABSTIME)); + 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 + TIMER_ABSTIME); foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep d_clock_gettime d_clock_getres - d_clock d_clock_nanosleep)) { + d_clock d_clock_nanosleep d_hires_stat)) { my $macro = $_; if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres|d_clock|d_clock_nanosleep)$/) { $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; + } elsif ($macro =~ /^(d_hires_stat)$/) { + my $d_hires_stat = 0; + $d_hires_stat = $1 if ($DEFINE =~ /-DTIME_HIRES_STAT=(\d+)/); + push @names, {name => $_, macro => "TIME_HIRES_STAT", value => $d_hires_stat, + default => ["IV", "0"]}; + next; } else { $macro =~ s/^d_(.+)/HAS_\U$1/; } diff --git a/ext/Time/HiRes/hints/aix.pl b/ext/Time/HiRes/hints/aix.pl new file mode 100644 index 0000000..bbb7fa8 --- /dev/null +++ b/ext/Time/HiRes/hints/aix.pl @@ -0,0 +1,18 @@ +# Many AIX installations seem not to have the right PATH +# for the C compiler. Steal the logic from Perl's hints/aix.sh. +use Config; +unless ($Config{gccversion}) { + my $cc = $Config{cc}; + if (! -x $cc && -x "/usr/vac/bin/$cc") { + unless (":$ENV{PATH}:" =~ m{:/usr/vac/bin:}) { + die <<__EOE__; +*** +*** You either implicitly or explicitly specified an IBM C compiler, +*** but you do not seem to have one in /usr/bin, but you seem to have +*** the VAC installed in /usr/vac, but you do not have the /usr/vac/bin +*** in your PATH. I suggest adding that and retrying Makefile.PL. +*** +__EOE__ + } + } +} diff --git a/ext/Time/HiRes/t/HiRes.t b/ext/Time/HiRes/t/HiRes.t index cae9889..3ac0ca1 100644 --- a/ext/Time/HiRes/t/HiRes.t +++ b/ext/Time/HiRes/t/HiRes.t @@ -12,7 +12,7 @@ BEGIN { } } -BEGIN { $| = 1; print "1..33\n"; } +BEGIN { $| = 1; print "1..38\n"; } END { print "not ok 1\n" unless $loaded } @@ -32,6 +32,7 @@ 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; +my $have_hires_stat = &Time::HiRes::d_hires_stat; sub has_symbol { my $symbol = shift; @@ -49,6 +50,7 @@ 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; +printf "# have_hires_stat = %d\n", $have_hires_stat; import Time::HiRes 'gettimeofday' if $have_gettimeofday; import Time::HiRes 'usleep' if $have_usleep; @@ -65,7 +67,7 @@ use Time::HiRes qw(gettimeofday); my $have_alarm = $Config{d_alarm}; my $have_fork = $Config{d_fork}; -my $waitfor = 60; # 10-20 seconds is normal (load affects this). +my $waitfor = 90; # 30-45 seconds is normal (load affects this). my $timer_pid; my $TheEnd; @@ -584,10 +586,80 @@ if ($have_clock) { print "not ok 33\n"; } } else { - print "# No clock\n"; skip 33; } +if ($have_ualarm) { + # 1_100_000 sligthly over 1_000_000, + # 2_200_000 slightly over 2**31/1000, + # 4_300_000 slightly over 2**32/1000. + for my $t ([34, 100_000], + [35, 1_100_000], + [36, 2_200_000], + [37, 4_300_000]) { + my ($i, $n) = @$t; + my $alarmed = 0; + local $SIG{ ALRM } = sub { $alarmed++ }; + my $t0 = Time::HiRes::time(); + print "# t0 = $t0\n"; + print "# ualarm($n)\n"; + ualarm($n); 1 while $alarmed == 0; + my $t1 = Time::HiRes::time(); + print "# t1 = $t1\n"; + my $dt = $t1 - $t0; + print "# dt = $dt\n"; + ok $i, $dt >= $n/1e6 && + ($n < 1_000_000 # Too much noise. + || $dt <= 1.5*$n/1e6), "ualarm($n) close enough"; + } +} else { + print "# No ualarm\n"; + skip 34..37; +} + +if (&Time::HiRes::d_hires_stat) { + my @stat; + my @time; + for (1..5) { + Time::HiRes::sleep(rand(0.1) + 0.1); + open(X, ">$$"); + print X $$; + close(X); + @stat = Time::HiRes::stat($$); + push @time, $stat[9]; + Time::HiRes::sleep(rand(0.1) + 0.1); + open(X, "<$$"); + ; + close(X); + @stat = Time::HiRes::stat($$); + push @time, $stat[8]; + } + 1 while unlink $$; + print "# @time\n"; + my $mi = 1; + my $ss = 0; + for (my $i = 1; $i < @time; $i++) { + if ($time[$i] > $time[$i-1]) { + $mi++; + } + if ($time[$i] > int($time[$i])) { + $ss++; + } + } + # Need at least 80% of monotonical increase and subsecond results. + if ($ss == 0) { + print "# No subsecond timestamps detected\n"; + skip 38; + } elsif ($mi/@time > 0.8 && $ss/@time > 0.8) { + print "ok 38\n"; + } else { + print "not ok 38\n"; + } +} else { + print "# No effectual d_hires_stat\n"; + skip 38; +} + END { if ($timer_pid) { # Only in the main process. my $left = $TheEnd - time();