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
-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
- 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
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;
=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);
my $ticktock = clock();
+ my @stat = stat(FH);
+
=head1 DESCRIPTION
The C<Time::HiRes> module implements a Perl interface to the
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<perlfunc/stat> 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
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)
#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
#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);
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(<<EOM);
+my $TIME_HEADERS = <<EOH;
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef I_SYS_TYPES
# include <sys/types.h>
#endif
-
#ifdef I_SYS_TIME
# include <sys/time.h>
#endif
-
#ifdef I_SYS_SELECT
# include <sys/select.h> /* 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(<<EOM);
+$TIME_HEADERS
static int foo()
{
struct timeval tv;
print "NOT found.\n";
}
+ print "Trying struct stat st_atimespec.tv_nsec...";
+ my $has_stat_st_xtimespec;
+ if (try_compile_and_link(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+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(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+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(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+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(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+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(<<EOM)) {
+$TIME_HEADERS
+#include <sys/stat.h>
+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') {
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/;
}
--- /dev/null
+# 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__
+ }
+ }
+}
}
}
-BEGIN { $| = 1; print "1..33\n"; }
+BEGIN { $| = 1; print "1..38\n"; }
END { print "not ok 1\n" unless $loaded }
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;
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;
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;
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, "<$$");
+ <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();
projects / p5sagit/p5-mst-13.2.git / commitdiff