'Time::HiRes' => {
'MAINTAINER' => 'zefram',
- 'DISTRIBUTION' => 'ZEFRAM/Time-HiRes-1.9725.tar.gz',
+ 'DISTRIBUTION' => 'ZEFRAM/Time-HiRes-1.9726.tar.gz',
'FILES' => q[cpan/Time-HiRes],
-
- # Waiting to be merged upstream: see CPAN RT#87858
- 'CUSTOMIZED' => [ 'Makefile.PL' ],
-
'UPSTREAM' => 'cpan',
},
Revision history for the Perl extension Time::HiRes.
+1.9726 [2013-08-17]
+ - Correct s/us splitting of usleep(1000000) [rt.cpan.org #78266].
+ - Avoid integer overflow in itimer-based alarm() with large
+ argument [rt.cpan.org #87160].
+ - Define PERL_NO_INLINE_FUNCTIONS during probe compilations, to
+ avoid false negatives caused by not linking with the perl core.
+ - Be more careful about context in stat().
+ - Install into "site" directories by default on perl 5.11+
+ [rt.cpan.org #79797].
+ - Fix a couple of doc typos [rt.cpan.org #85365].
+ - Fix function name in a doc example [rt.cpan.org #86318].
+ - Provide lstat() that yields high-res timestamps, alongside
+ the existing high-res stat() [rt.cpan.org #78732].
+
1.9725 [2012-02-01]
- Correct stack discipline in stat(), which was screwing up list
operations in expressions containing calls to it [rt.cpan.org
d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
d_nanosleep d_clock_gettime d_clock_getres
d_clock d_clock_nanosleep
- stat
+ stat lstat
);
-our $VERSION = '1.9725';
+our $VERSION = '1.9726';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep
clock_gettime clock_getres clock_nanosleep clock
- stat );
+ stat lstat );
usleep ($microseconds);
nanosleep ($nanoseconds);
my $ticktock = clock();
- use Time::HiRes qw( stat );
+ use Time::HiRes qw( stat lstat );
my @stat = stat("file");
my @stat = stat(FH);
+ my @stat = lstat("file");
=head1 DESCRIPTION
in a pre-emptive multiuser system. Understand the difference between
I<wallclock time> and process time (in UNIX-like systems the sum of
I<user> and I<system> times). Any attempt to sleep for X seconds will
-most probably end up sleeping B<more> than that, but don't be surpised
+most probably end up sleeping B<more> than that, but don't be surprised
if you end up sleeping slightly B<less>.
The following functions can be imported from this module.
C<ITIMER_REALPROF>. Note that which ones are available depends: true
UNIX platforms usually have the first three, but only Solaris seems to
have C<ITIMER_REALPROF> (which is used to profile multithreaded programs).
-Win32 unfortunately does not haveinterval timers.
+Win32 unfortunately does not have interval timers.
C<ITIMER_REAL> results in C<alarm()>-like behaviour. Time is counted in
I<real time>; that is, wallclock time. C<SIGALRM> is delivered when
=item stat EXPR
-As L<perlfunc/stat> but with the access/modify/change file timestamps
+=item lstat
+
+=item lstat FH
+
+=item lstat EXPR
+
+As L<perlfunc/stat> or L<perlfunc/lstat>
+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():
granularity is B<two> seconds).
A zero return value of &Time::HiRes::d_hires_stat means that
-Time::HiRes::stat is a no-op passthrough for CORE::stat(),
+Time::HiRes::stat is a no-op passthrough for CORE::stat()
+(and likewise for lstat),
and therefore the timestamps will stay integers. The same
thing will happen if the filesystem does not do subsecond timestamps,
even if the &Time::HiRes::d_hires_stat is non-zero.
use Time::HiRes qw( clock_gettime clock_getres CLOCK_REALTIME );
# Read the POSIX high resolution timer.
- my $high = clock_getres(CLOCK_REALTIME);
+ my $high = clock_gettime(CLOCK_REALTIME);
# But how accurate we can be, really?
my $reso = clock_getres(CLOCK_REALTIME);
Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Jarkko Hietaniemi.
All rights reserved.
-Copyright (C) 2011, 2012 Andrew Main (Zefram) <zefram@fysh.org>
+Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) <zefram@fysh.org>
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
* Copyright (c) 2002-2010 Jarkko Hietaniemi.
* All rights reserved.
*
- * Copyright (C) 2011, 2012 Andrew Main (Zefram) <zefram@fysh.org>
+ * Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) <zefram@fysh.org>
*
* This program is free software; you can redistribute it and/or modify
* it under the same terms as Perl itself.
}
#endif
+#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
+#define PERL_DECIMAL_VERSION \
+ PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#define PERL_VERSION_GE(r,v,s) \
+ (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+
/* At least ppport.h 3.13 gets this wrong: one really cannot
* have NVgf as anything else than "g" under Perl 5.6.x. */
#if PERL_REVISION == 5 && PERL_VERSION == 6
# define NVgf "g"
#endif
+#if PERL_VERSION_GE(5,7,3) && !PERL_VERSION_GE(5,10,1)
+# undef SAVEOP
+# define SAVEOP() SAVEVPTR(PL_op)
+#endif
+
#define IV_1E6 1000000
#define IV_1E7 10000000
#define IV_1E9 1000000000
CODE:
gettimeofday(&Ta, NULL);
if (items > 0) {
- if (useconds > 1E6) {
+ if (useconds >= 1E6) {
IV seconds = (IV) (useconds / 1E6);
/* If usleep() has been implemented using setitimer()
* then this contortion is unnecessary-- but usleep()
if (seconds < 0.0 || interval < 0.0)
croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
{
- IV useconds = IV_1E6 * seconds;
- IV uinterval = IV_1E6 * interval;
+ IV iseconds = (IV)seconds;
+ IV iinterval = (IV)interval;
+ NV fseconds = seconds - iseconds;
+ NV finterval = interval - iinterval;
+ IV useconds, uinterval;
+ if (fseconds >= 1.0 || finterval >= 1.0)
+ croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): seconds or interval too large to split correctly", seconds, interval);
+ useconds = IV_1E6 * fseconds;
+ uinterval = IV_1E6 * finterval;
#if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
{
- struct itimerval itv;
- if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
+ struct itimerval nitv, oitv;
+ nitv.it_value.tv_sec = iseconds;
+ nitv.it_value.tv_usec = useconds;
+ nitv.it_interval.tv_sec = iinterval;
+ nitv.it_interval.tv_usec = uinterval;
+ if (setitimer(ITIMER_REAL, &nitv, &oitv)) {
/* To conform to alarm's interface, we're actually ignoring
an error here. */
RETVAL = 0;
} else {
- RETVAL = itv.it_value.tv_sec + ((NV)itv.it_value.tv_usec) / NV_1E6;
+ RETVAL = oitv.it_value.tv_sec + ((NV)oitv.it_value.tv_usec) / NV_1E6;
}
}
#else
- if (useconds >= IV_1E6 || uinterval >= IV_1E6)
- croak("Time::HiRes::alarm(%d, %d): seconds or interval equal to or more than 1.0 ", useconds, uinterval, IV_1E6);
+ if (iseconds || iinterval)
+ croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): seconds or interval equal to or more than 1.0 ", seconds, interval);
RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6;
#endif
}
void
stat(...)
PROTOTYPE: ;$
+ PREINIT:
+ OP fakeop;
+ int nret;
+ ALIAS:
+ Time::HiRes::lstat = 1
PPCODE:
XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV)));
PUTBACK;
ENTER;
PL_laststatval = -1;
- (void)*(PL_ppaddr[OP_STAT])(aTHXR);
+ SAVEOP();
+ Zero(&fakeop, 1, OP);
+ fakeop.op_type = ix ? OP_LSTAT : OP_STAT;
+ fakeop.op_ppaddr = PL_ppaddr[fakeop.op_type];
+ fakeop.op_flags = GIMME_V == G_ARRAY ? OPf_WANT_LIST :
+ GIMME_V == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID;
+ PL_op = &fakeop;
+ (void)fakeop.op_ppaddr(aTHXR);
SPAGAIN;
LEAVE;
- if (PL_laststatval == 0) {
- /* We assume that pp_stat() left us with 13 valid stack items,
- * and that the timestamps are at offsets 8, 9, and 10. */
+ nret = SP+1 - &ST(0);
+ if (nret == 13) {
UV atime = SvUV(ST( 8));
UV mtime = SvUV(ST( 9));
UV ctime = SvUV(ST(10));
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);
+ XSRETURN(nret);
# Do not even think about 'INC' => '-I/usr/ucbinclude',
# Solaris will avenge.
'INC' => '', # e.g., '-I/usr/include/other'
- 'INSTALLDIRS' => ($] >= 5.008 ? 'perl' : 'site'),
+ 'INSTALLDIRS' => ($] >= 5.008 && $] < 5.011 ? 'perl' : 'site'),
'PREREQ_PM' => {
'Carp' => 0,
'Config' => 0,
}
}
-use Test::More 0.82 tests => 16;
+use Test::More 0.82 tests => 43;
use t::Watchdog;
my $limit = 0.25; # 25% is acceptable slosh for testing timers
is $b, "b";
is ref($stat), "ARRAY";
push @mtime, $stat->[9];
+ ($a, my $lstat, $b) = ("a", [Time::HiRes::lstat($$)], "b");
+ is $a, "a";
+ is $b, "b";
+ is_deeply $lstat, $stat;
Time::HiRes::sleep(rand(0.1) + 0.1);
open(X, "<$$");
<X>;
close(X);
$stat = [Time::HiRes::stat($$)];
push @atime, $stat->[8];
+ $lstat = [Time::HiRes::lstat($$)];
+ is_deeply $lstat, $stat;
}
1 while unlink $$;
note "mtime = @mtime";
$ss/(@mtime+@atime) >= 0.2;
}
+my $targetname = "tgt$$";
+my $linkname = "link$$";
+SKIP: {
+ open(X, ">$targetname");
+ print X $$;
+ close(X);
+ eval { symlink $targetname, $linkname or die "can't symlink: $!"; };
+ skip "can't symlink", 7 if $@ ne "";
+ my @tgt_stat = Time::HiRes::stat($targetname);
+ my @tgt_lstat = Time::HiRes::lstat($targetname);
+ my @lnk_stat = Time::HiRes::stat($linkname);
+ my @lnk_lstat = Time::HiRes::lstat($linkname);
+ is scalar(@tgt_stat), 13;
+ is scalar(@tgt_lstat), 13;
+ is scalar(@lnk_stat), 13;
+ is scalar(@lnk_lstat), 13;
+ is_deeply \@tgt_stat, \@tgt_lstat;
+ is_deeply \@tgt_stat, \@lnk_stat;
+ isnt $lnk_lstat[2], $tgt_stat[2];
+}
+1 while unlink $linkname;
+1 while unlink $targetname;
+
1;
=item *
+L<Time::HiRes> has been upgraded from version 1.9725 to 1.9726.
+
+Now provides an C<lstat> function.
+Various bugs fixed.
+
+=item *
+
L<Time::Piece> has been upgraded from version 1.21 to 1.22.
XXX: TODO
projects / platform / upstream / perl.git / commitdiff