From 0f0eae2c6d98019e82bf4e2a5bad67ab3e4ed1e7 Mon Sep 17 00:00:00 2001 From: Zefram Date: Sat, 17 Aug 2013 23:47:23 +0100 Subject: [PATCH] update Time-HiRes to version 1.9726 from CPAN --- Porting/Maintainers.pl | 6 +---- cpan/Time-HiRes/Changes | 14 ++++++++++ cpan/Time-HiRes/HiRes.pm | 29 +++++++++++++-------- cpan/Time-HiRes/HiRes.xs | 62 ++++++++++++++++++++++++++++++++++----------- cpan/Time-HiRes/Makefile.PL | 2 +- cpan/Time-HiRes/t/stat.t | 31 ++++++++++++++++++++++- pod/perldelta.pod | 7 +++++ 7 files changed, 119 insertions(+), 32 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 7d4482c..2f1b3ed 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1899,12 +1899,8 @@ use File::Glob qw(:case); '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', }, diff --git a/cpan/Time-HiRes/Changes b/cpan/Time-HiRes/Changes index d5a2831..445b2be 100644 --- a/cpan/Time-HiRes/Changes +++ b/cpan/Time-HiRes/Changes @@ -1,5 +1,19 @@ 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 diff --git a/cpan/Time-HiRes/HiRes.pm b/cpan/Time-HiRes/HiRes.pm index 5223ba9..cf64bc1 100644 --- a/cpan/Time-HiRes/HiRes.pm +++ b/cpan/Time-HiRes/HiRes.pm @@ -20,10 +20,10 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval 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; @@ -87,7 +87,7 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep clock_gettime clock_getres clock_nanosleep clock - stat ); + stat lstat ); usleep ($microseconds); nanosleep ($nanoseconds); @@ -125,10 +125,11 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers 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 @@ -168,7 +169,7 @@ any clocks and timers will be imprecise, especially so if you are working in a pre-emptive multiuser system. Understand the difference between I and process time (in UNIX-like systems the sum of I and I times). Any attempt to sleep for X seconds will -most probably end up sleeping B than that, but don't be surpised +most probably end up sleeping B than that, but don't be surprised if you end up sleeping slightly B. The following functions can be imported from this module. @@ -302,7 +303,7 @@ C<$which> can be C, C, C, or C. Note that which ones are available depends: true UNIX platforms usually have the first three, but only Solaris seems to have C (which is used to profile multithreaded programs). -Win32 unfortunately does not haveinterval timers. +Win32 unfortunately does not have interval timers. C results in C-like behaviour. Time is counted in I; that is, wallclock time. C is delivered when @@ -392,7 +393,14 @@ compatibility limitations the returned value may wrap around at about =item stat EXPR -As L but with the access/modify/change file timestamps +=item lstat + +=item lstat FH + +=item lstat EXPR + +As L or 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(): @@ -406,7 +414,8 @@ UNIX filesystems often do; NTFS does; FAT doesn't (FAT timestamp granularity is B 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. @@ -476,7 +485,7 @@ time stamp from t1: it may be equal or I. 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); @@ -586,7 +595,7 @@ Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved. Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Jarkko Hietaniemi. All rights reserved. -Copyright (C) 2011, 2012 Andrew Main (Zefram) +Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/Time-HiRes/HiRes.xs b/cpan/Time-HiRes/HiRes.xs index 64e63d6..96640e9 100644 --- a/cpan/Time-HiRes/HiRes.xs +++ b/cpan/Time-HiRes/HiRes.xs @@ -5,7 +5,7 @@ * Copyright (c) 2002-2010 Jarkko Hietaniemi. * All rights reserved. * - * Copyright (C) 2011, 2012 Andrew Main (Zefram) + * Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) * * This program is free software; you can redistribute it and/or modify * it under the same terms as Perl itself. @@ -40,6 +40,12 @@ extern "C" { } #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 @@ -47,6 +53,11 @@ extern "C" { # 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 @@ -792,7 +803,7 @@ usleep(useconds) 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() @@ -941,22 +952,33 @@ alarm(seconds,interval=0) 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 } @@ -1245,17 +1267,28 @@ clock() 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)); @@ -1269,6 +1302,5 @@ PROTOTYPE: ;$ 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); diff --git a/cpan/Time-HiRes/Makefile.PL b/cpan/Time-HiRes/Makefile.PL index f27439e..394cb91 100644 --- a/cpan/Time-HiRes/Makefile.PL +++ b/cpan/Time-HiRes/Makefile.PL @@ -759,7 +759,7 @@ sub doMakefile { # 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, diff --git a/cpan/Time-HiRes/t/stat.t b/cpan/Time-HiRes/t/stat.t index 4b81561..eca9da1 100644 --- a/cpan/Time-HiRes/t/stat.t +++ b/cpan/Time-HiRes/t/stat.t @@ -13,7 +13,7 @@ BEGIN { } } -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 @@ -30,12 +30,18 @@ for (1..5) { 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, "<$$"); ; close(X); $stat = [Time::HiRes::stat($$)]; push @atime, $stat->[8]; + $lstat = [Time::HiRes::lstat($$)]; + is_deeply $lstat, $stat; } 1 while unlink $$; note "mtime = @mtime"; @@ -68,4 +74,27 @@ SKIP: { $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; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 4577d9c..fd9e655 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -374,6 +374,13 @@ Avoid creating temporary objects for STORABLE_attach when they aren't required. =item * +L has been upgraded from version 1.9725 to 1.9726. + +Now provides an C function. +Various bugs fixed. + +=item * + L has been upgraded from version 1.21 to 1.22. XXX: TODO -- 2.7.4