update Time-HiRes to version 1.9726 from CPAN

5 files changed, 111 insertions, 27 deletions

diff --git a/cpan/Time-HiRes/Changes b/cpan/Time-HiRes/Changes
index d5a283100a..445b2bee56 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 5223ba99e9..cf64bc1fbb 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<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.
@@ -302,7 +303,7 @@ C<$which> can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or
 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
@@ -392,7 +393,14 @@ compatibility limitations the returned value may wrap around at about
 
 =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():
 
@@ -406,7 +414,8 @@ UNIX filesystems often do; NTFS does; FAT doesn't (FAT timestamp
 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.
@@ -476,7 +485,7 @@ time stamp from t1: it may be equal or I<less>.
 
   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) <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.
diff --git a/cpan/Time-HiRes/HiRes.xs b/cpan/Time-HiRes/HiRes.xs
index 64e63d6b13..96640e9b03 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) <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.
@@ -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 f27439e800..394cb91b06 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 4b81561f40..eca9da12e3 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, "<$$");
     <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;