This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "Update Time-HiRes to CPAN version 1.9735"
authorDavid Mitchell <davem@iabyn.com>
Tue, 21 Jun 2016 14:48:57 +0000 (15:48 +0100)
committerDavid Mitchell <davem@iabyn.com>
Tue, 21 Jun 2016 14:57:33 +0000 (15:57 +0100)
This reverts commit e6da2a9c4c0cecea6bf21f8ae47d78bdbe8bcbce.

This was hanging parallel testing on my Linux box.
Cause not yest investigated, but revert for now.

MANIFEST
Porting/Maintainers.pl
dist/Time-HiRes/Changes
dist/Time-HiRes/HiRes.pm
dist/Time-HiRes/HiRes.xs
dist/Time-HiRes/Makefile.PL
dist/Time-HiRes/fallback/const-c.inc
dist/Time-HiRes/t/utime.t [deleted file]

index ab6cf77..25252df 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3684,7 +3684,6 @@ dist/Time-HiRes/t/time.t          Test for Time::HiRes
 dist/Time-HiRes/t/tv_interval.t                Test for Time::HiRes
 dist/Time-HiRes/t/ualarm.t             Test for Time::HiRes
 dist/Time-HiRes/t/usleep.t             Test for Time::HiRes
-dist/Time-HiRes/t/utime.t
 dist/Time-HiRes/t/Watchdog.pm          Test for Time::HiRes
 dist/Time-HiRes/typemap                        Time::HiRes extension
 dist/XSLoader/Makefile.PL      Dynamic Loader makefile writer
index e50536d..0a97c3a 100755 (executable)
@@ -1174,7 +1174,7 @@ use File::Glob qw(:case);
     },
 
     'Time::HiRes' => {
-        'DISTRIBUTION' => 'JHI/Time-HiRes-1.9735.tar.gz',
+        'DISTRIBUTION' => 'JHI/Time-HiRes-1.9733.tar.gz',
         'FILES'        => q[dist/Time-HiRes],
     },
 
index 110787c..9d097c5 100644 (file)
@@ -1,18 +1,5 @@
 Revision history for the Perl extension Time::HiRes.
 
-1.9735 [2016-07-21]
-  - Time::HiRes should override `utime` to allow setting hires
-    (use futimens and utimensat to implement subsecond utime)
-    [rt.perl.org #114809]
-  - the utime patch uses IS_SAFE_PATHNAME() which isn't available in
-    too old Perls, so emulate (in case the Devel::PPPort is too old)
-  - make it so that only one value is set for -DTIME_HIRES_STAT
-    even on systems that support many options
-
-1.9734 [2016-07-17]
-  - fix Darwins with clock_gettime: blead 2d41a263
-    [rt.perl.org #128427]
-
 1.9733 [2016-04-23]
   - C90 declaration-after-statement error with darwin threads: blead de1003b4
     [rt.cpan.org #113856]
index bd92f78..e22a663 100644 (file)
@@ -23,12 +23,12 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
                 ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF
                 TIMER_ABSTIME
                 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
-                d_nanosleep d_clock_gettime d_clock_getres d_hires_utime
+                d_nanosleep d_clock_gettime d_clock_getres
                 d_clock d_clock_nanosleep
-                stat lstat utime
+                stat lstat
                );
 
-our $VERSION = '1.9735';
+our $VERSION = '1.9734';
 our $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -60,7 +60,6 @@ sub import {
            ($i eq 'clock'           && !&d_clock)           ||
            ($i eq 'nanosleep'       && !&d_nanosleep)       ||
            ($i eq 'usleep'          && !&d_usleep)          ||
-           ($i eq 'utime'           && !&d_hires_utime)     ||
            ($i eq 'ualarm'          && !&d_ualarm)) {
            require Carp;
            Carp::croak("Time::HiRes::$i(): unimplemented in this platform");
@@ -93,7 +92,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 lstat utime);
+                      stat lstat );
 
   usleep ($microseconds);
   nanosleep ($nanoseconds);
@@ -138,9 +137,6 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
   my @stat = stat(FH);
   my @stat = lstat("file");
 
-  use Time::HiRes qw( utime );
-  utime $floating_seconds_atime, $floating_seconds_mtime, $file...;
-
 =head1 DESCRIPTION
 
 The C<Time::HiRes> module implements a Perl interface to the
@@ -450,23 +446,6 @@ if the operations are
 the access time stamp from t2 need not be greater-than the modify
 time stamp from t1: it may be equal or I<less>.
 
-=item utime LIST
-
-As L<perlfunc/utime> but with the ability to set the access/modify
-file timestamps in subsecond resolution, if the operating system and
-the filesystem both support such timestamps.  To override the standard
-utime():
-
-    use Time::HiRes qw(utime);
-
-Test for the value of &Time::HiRes::d_hires_utime to find out whether
-the operating system supports setting subsecond file timestamps.
-
-As with CORE::utime(), passing undef as both the atime and mtime will
-call the syscall with a NULL argument.
-
-Returns the number of files successfully changed.
-
 =back
 
 =head1 EXAMPLES
index ad0b834..ed60336 100644 (file)
@@ -921,12 +921,6 @@ nsec_without_unslept(struct timespec *sleepfor,
 
 #endif
 
-/* In case Perl and/or Devel::PPPort are too old, minimally emulate
- * IS_SAFE_PATHNAME() (which looks for zero bytes in the pathname). */
- #ifndef IS_SAFE_PATHNAME
-#define IS_SAFE_PATHNAME(pv, len, opname) (((len)>1)&&memchr((pv), 0, (len)-1)?(SETERRNO(ENOENT, LIB_INVARG),Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Invalid \\0 character in pathname for %s",opname),FALSE):(TRUE))
-#endif
-
 MODULE = Time::HiRes            PACKAGE = Time::HiRes
 
 PROTOTYPES: ENABLE
@@ -1323,83 +1317,6 @@ getitimer(which)
 
 #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
 
-#if defined(TIME_HIRES_UTIME)
-
-I32
-utime(accessed, modified, ...)
-PROTOTYPE: $$@
-    PREINIT:
-       SV* accessed;
-       SV* modified;
-       SV* file;
-
-       struct timespec utbuf[2];
-       struct timespec *utbufp = utbuf;
-       int tot;
-
-    CODE:
-       dXSARGS;
-       accessed = ST(0);
-       modified = ST(1);
-       items -= 2;
-       tot = 0;
-
-       if ( accessed == &PL_sv_undef && modified == &PL_sv_undef )
-               utbufp = NULL;
-       else {
-               if (SvNV(accessed) < 0.0 || SvNV(modified) < 0.0)
-                       croak("Time::HiRes::utime(%"NVgf", %"NVgf"): negative time not invented yet", SvNV(accessed), SvNV(modified));
-               Zero(&utbuf, sizeof utbuf, char);
-               utbuf[0].tv_sec = (Time_t)SvNV(accessed);  /* time accessed */
-               utbuf[0].tv_nsec = (long)( ( SvNV(accessed) - utbuf[0].tv_sec ) * 1e9 );
-               utbuf[1].tv_sec = (Time_t)SvNV(modified);  /* time modified */
-               utbuf[1].tv_nsec = (long)( ( SvNV(modified) - utbuf[1].tv_sec ) * 1e9 );
-       }
-
-       while (items > 0) {
-               file = POPs; items--;
-
-               if (SvROK(file) && GvIO(SvRV(file)) && IoIFP(sv_2io(SvRV(file)))) {
-                       int fd =  PerlIO_fileno(IoIFP(sv_2io(file)));
-                       if (fd < 0)
-                               SETERRNO(EBADF,RMS_IFI);
-                       else 
-#ifdef HAS_FUTIMENS
-                       if (futimens(fd, utbufp) == 0)
-                               tot++;
-#else  /* HAS_FUTIMES */
-                               croak("futimens unimplemented in this platform");
-#endif /* HAS_FUTIMES */
-               }
-               else {
-#ifdef HAS_UTIMENSAT
-                       STRLEN len;
-                       char * name = SvPV(file, len);
-                       if (IS_SAFE_PATHNAME(name, len, "utime") &&
-                           utimensat(AT_FDCWD, name, utbufp, 0) == 0)
-                               tot++;
-#else  /* HAS_UTIMENSAT */
-                       croak("utimensat unimplemented in this platform");
-#endif /* HAS_UTIMENSAT */
-               }
-       } /* while items */
-       RETVAL = tot;
-
-    OUTPUT:
-       RETVAL
-
-#else  /* #if defined(TIME_HIRES_UTIME) */
-
-I32
-utime(accessed, modified, ...)
-    CODE:
-        croak("Time::HiRes::utime(): unimplemented in this platform");
-        RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-#endif /* #if defined(TIME_HIRES_UTIME) */
-
 #if defined(TIME_HIRES_CLOCK_GETTIME)
 
 NV
index 8622273..087ab79 100644 (file)
@@ -354,41 +354,6 @@ int main(int argc, char** argv)
 EOM
 }
 
-sub has_futimens {
-    return 1 if
-    try_compile_and_link(<<EOM);
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <sys/time.h>
-int main(int argc, char** argv)
-{
-    int ret;
-    struct timespec ts[2];
-    ret = futimens(0, ts);
-    ret == 0 ? exit(0) : exit(errno ? errno : -1);
-}
-EOM
-}
-
-sub has_utimensat{
-    return 1 if
-    try_compile_and_link(<<EOM);
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <sys/time.h>
-#include <fcntl.h>
-int main(int argc, char** argv)
-{
-    int ret;
-    struct timespec ts[2];
-    ret = utimensat(AT_FDCWD, 0, ts, 0);
-    ret == 0 ? exit(0) : exit(errno ? errno : -1);
-}
-EOM
-}
-
 sub DEFINE {
     my ($def, $val) = @_;
     my $define = defined $val ? "$def=$val" : $def ;
@@ -666,36 +631,6 @@ EOD
        print "NOT found.\n";
     }
 
-    print "Looking for futimens()... ";
-    my $has_futimens;
-    if (has_futimens()) {
-        $has_futimens++;
-       $DEFINE .= ' -DHAS_FUTIMENS';
-    }
-
-    if ($has_futimens) {
-        print "found.\n";
-    } else {
-       print "NOT found.\n";
-    }
-
-    print "Looking for utimensat()... ";
-    my $has_utimensat;
-    if (has_utimensat()) {
-        $has_utimensat++;
-       $DEFINE .= ' -DHAS_UTIMENSAT';
-    }
-
-    if ($has_utimensat) {
-        print "found.\n";
-    } else {
-       print "NOT found.\n";
-    }
-
-    if ($has_futimens or $has_utimensat) {
-       $DEFINE .= ' -DTIME_HIRES_UTIME';
-    }
-
     print "Looking for stat() subsecond timestamps...\n";
 
     print "Trying struct stat st_atimespec.tv_nsec...";
@@ -709,7 +644,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtimespec++;
-      DEFINE('TIME_HIRES_STAT_ST_XTIMESPEC');  # 1
+      DEFINE('TIME_HIRES_STAT', 1);
     }
 
     if ($has_stat_st_xtimespec) {
@@ -729,7 +664,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtimensec++;
-      DEFINE('TIME_HIRES_STAT_ST_XTIMENSEC');  # 2
+      DEFINE('TIME_HIRES_STAT', 2);
     }
 
     if ($has_stat_st_xtimensec) {
@@ -749,7 +684,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtime_n++;
-      DEFINE('TIME_HIRES_STAT_ST_XTIME_N');  # 3
+      DEFINE('TIME_HIRES_STAT', 3);
     }
 
     if ($has_stat_st_xtime_n) {
@@ -769,7 +704,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_xtim++;
-      DEFINE('TIME_HIRES_STAT_XTIM');  # 4
+      DEFINE('TIME_HIRES_STAT', 4);
     }
 
     if ($has_stat_st_xtim) {
@@ -789,7 +724,7 @@ int main(int argc, char** argv) {
 }
 EOM
       $has_stat_st_uxtime++;
-      DEFINE('TIME_HIRES_STAT_ST_UXTIME');  # 5
+      DEFINE('TIME_HIRES_STAT', 5);
     }
 
     if ($has_stat_st_uxtime) {
@@ -798,19 +733,6 @@ EOM
        print "NOT found.\n";
     }
 
-    # See HiRes.xs hrstatns()
-    if ($has_stat_st_xtimespec) {
-        DEFINE('TIME_HIRES_STAT', 1);
-    } elsif ($has_stat_st_xtimensec) {
-        DEFINE('TIME_HIRES_STAT', 2);
-    } elsif ($has_stat_st_xtime_n) {
-        DEFINE('TIME_HIRES_STAT', 3);
-    } elsif ($has_stat_st_xtim) {
-        DEFINE('TIME_HIRES_STAT', 4);
-    } elsif ($has_stat_st_uxtime) {
-        DEFINE('TIME_HIRES_STAT', 5);
-    }    
-
    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";
@@ -947,7 +869,7 @@ sub doConstants {
                       );
        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_hires_stat d_hires_utime)) {
+                    d_clock d_clock_nanosleep d_hires_stat)) {
            my $macro = $_;
            if ($macro =~ /^(d_nanosleep|d_clock)$/) {
                $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
@@ -963,8 +885,6 @@ sub doConstants {
                push @names, {name => $_, macro => $macro, value => $val,
                              default => ["IV", "0"]};
                next;
-           } elsif ($macro =~ /^(d_hires_.*)$/) {
-               $macro =~ s/^d_(.+)/TIME_\U$1/;
            } else {
                $macro =~ s/^d_(.+)/HAS_\U$1/;
            }
index 524db16..a862617 100644 (file)
@@ -19,7 +19,6 @@ typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
 #ifndef pTHX_
 #define pTHX_ /* 5.6 or later define this for threading support.  */
 #endif
-
 static int
 constant_11 (pTHX_ const char *name, IV *iv_return) {
   /* When generated this function returned values for the list of names given
@@ -88,51 +87,6 @@ constant_11 (pTHX_ const char *name, IV *iv_return) {
 }
 
 static int
-constant_13 (pTHX_ const char *name, IV *iv_return) {
-  /* When generated this function returned values for the list of names given
-     here.  However, subsequent manual editing may have added or removed some.
-     CLOCK_HIGHRES TIMER_ABSTIME d_hires_utime */
-  /* Offset 1 gives the best switch position.  */
-  switch (name[1]) {
-  case 'I':
-    if (memEQ(name, "TIMER_ABSTIME", 13)) {
-    /*                ^                  */
-#ifdef TIMER_ABSTIME
-      *iv_return = TIMER_ABSTIME;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case 'L':
-    if (memEQ(name, "CLOCK_HIGHRES", 13)) {
-    /*                ^                  */
-#ifdef CLOCK_HIGHRES
-      *iv_return = CLOCK_HIGHRES;
-      return PERL_constant_ISIV;
-#else
-      return PERL_constant_NOTDEF;
-#endif
-    }
-    break;
-  case '_':
-    if (memEQ(name, "d_hires_utime", 13)) {
-    /*                ^                  */
-#ifdef TIME_HIRES_UTIME
-      *iv_return = 1;
-      return PERL_constant_ISIV;
-#else
-      *iv_return = 0;
-      return PERL_constant_ISIV;
-#endif
-    }
-    break;
-  }
-  return PERL_constant_NOTFOUND;
-}
-
-static int
 constant_14 (pTHX_ const char *name, IV *iv_return) {
   /* When generated this function returned values for the list of names given
      here.  However, subsequent manual editing may have added or removed some.
@@ -296,17 +250,16 @@ my @names = (qw(CLOCKS_PER_SEC CLOCK_HIGHRES CLOCK_MONOTONIC
             {name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]},
             {name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]},
             {name=>"d_hires_stat", type=>"IV", macro=>"TIME_HIRES_STAT", value=>"1", default=>["IV", "0"]},
-            {name=>"d_hires_utime", type=>"IV", macro=>"TIME_HIRES_UTIME", value=>"1", default=>["IV", "0"]},
             {name=>"d_nanosleep", type=>"IV", macro=>"TIME_HIRES_NANOSLEEP", value=>"1", default=>["IV", "0"]},
             {name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]},
             {name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]},
             {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]});
 
-print constant_types(), "\n"; # macro defs
+print constant_types(); # macro defs
 foreach (C_constant ("Time::HiRes", 'constant', 'IV', $types, undef, 3, @names) ) {
     print $_, "\n"; # C constant subs
 }
-print "\n#### XS Section:\n";
+print "#### XS Section:\n";
 print XS_constant ("Time::HiRes", $types);
 __END__
    */
@@ -369,7 +322,33 @@ __END__
     }
     break;
   case 13:
-    return constant_13 (aTHX_ name, iv_return);
+    /* Names all of length 13.  */
+    /* CLOCK_HIGHRES TIMER_ABSTIME */
+    /* Offset 2 gives the best switch position.  */
+    switch (name[2]) {
+    case 'M':
+      if (memEQ(name, "TIMER_ABSTIME", 13)) {
+      /*                 ^                 */
+#ifdef TIMER_ABSTIME
+        *iv_return = TIMER_ABSTIME;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'O':
+      if (memEQ(name, "CLOCK_HIGHRES", 13)) {
+      /*                 ^                 */
+#ifdef CLOCK_HIGHRES
+        *iv_return = CLOCK_HIGHRES;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    }
     break;
   case 14:
     return constant_14 (aTHX_ name, iv_return);
diff --git a/dist/Time-HiRes/t/utime.t b/dist/Time-HiRes/t/utime.t
deleted file mode 100644 (file)
index 5de86c2..0000000
+++ /dev/null
@@ -1,84 +0,0 @@
-use strict;
-
-BEGIN {
-    require Time::HiRes;
-    unless(&Time::HiRes::d_hires_utime) {
-       require Test::More;
-       Test::More::plan(skip_all => "no hires_utime()");
-    }
-}
-
-use Test::More;
-use t::Watchdog;
-use File::Temp qw( tempfile );
-
-use Config;
-
-my $atime = 1.111111111;
-my $mtime = 2.222222222;
-
-subtest "utime \$fh" => sub {
-       my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
-       is Time::HiRes::utime($atime, $mtime, $fh), 1, "One file changed";
-       my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename) )[8, 9];
-       is $got_atime, $atime, "atime set correctly";
-       is $got_mtime, $mtime, "mtime set correctly";
-};
-
-subtest "utime \$filename" => sub {
-       my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
-       is Time::HiRes::utime($atime, $mtime, $filename), 1, "One file changed";
-       my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9];
-       is $got_atime, $atime, "atime set correctly";
-       is $got_mtime, $mtime, "mtime set correctly";
-};
-
-subtest "utime \$filename and \$fh" => sub {
-       my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
-       my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
-       is Time::HiRes::utime($atime, $mtime, $filename1, $fh2), 2, "Two files changed";
-       {
-               my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9];
-               is $got_atime, $atime, "File 1 atime set correctly";
-               is $got_mtime, $mtime, "File 1 mtime set correctly";
-       }
-       {
-               my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9];
-               is $got_atime, $atime, "File 2 atime set correctly";
-               is $got_mtime, $mtime, "File 2 mtime set correctly";
-       }
-};
-
-subtest "utime undef sets time to now" => sub {
-       my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
-       my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
-
-       my $now = Time::HiRes::time;
-       is Time::HiRes::utime(undef, undef, $filename1, $fh2), 2, "Two files changed";
-
-       {
-               my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9];
-               cmp_ok abs( $got_atime - $now), '<', 0.1, "File 1 atime set correctly";
-               cmp_ok abs( $got_mtime - $now), '<', 0.1, "File 1 mtime set correctly";
-       }
-       {
-               my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9];
-               cmp_ok abs( $got_atime - $now), '<', 0.1, "File 2 atime set correctly";
-               cmp_ok abs( $got_mtime - $now), '<', 0.1, "File 2 mtime set correctly";
-       }
-};
-
-subtest "negative atime dies" => sub {
-       eval { Time::HiRes::utime(-4, $mtime) };
-       like $@, qr/::utime\(-4, 2\.22222\): negative time not invented yet/,
-               "negative time error";
-};
-
-subtest "negative mtime dies" => sub {
-       eval { Time::HiRes::utime($atime, -4) };
-       like $@, qr/::utime\(1.11111, -4\): negative time not invented yet/,
-               "negative time error";
-};
-
-done_testing;
-1;