This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Time-HiRes to CPAN version 1.9752
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 9 Jan 2018 12:41:38 +0000 (12:41 +0000)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 9 Jan 2018 12:41:38 +0000 (12:41 +0000)
  [DELTA]

1.9752 [2018-01-04]
 - fix an error in the error message of utimensat() not available:
   it said futimens() not available
 - add --force alias for Makefile.PL --configure

1.9751 [2018-01-02]
 - in macOS/OSX/Darwin, use __has_builtin() check also for utimensat(),
   can cause errors like
   "HiRes.xs:1474:16: error: unrecognized platform name macOS"
   [rt.cpan.org #123994]
   (oversight from 1.9749)
 - do not define TIME_HIRES_STAT/d_hires_stat if none was found, instead
   of defining it to be zero, which case has no implementation in hrstatns()
   (thanks to Nigel Horne)
 - in t/utime.t try to divine if the filesystem of the tempfiles has been
   mounted with the 'noatime' option, which can prohibit updating the
   access time timestamp.  Also document this in HiRes.pm.
   (thanks to Nigel Horne, original analysis by Slaven Rezic)
 - synchronize the constant lists in HiRes.pm:@EXPORT_OK
   and Makefile.PL:doConstants and regenerate fallback/const-c.inc
   and fallback/const-xs.inc, this fixes Perl 5.6.2 issue with
   d_futimens not allegedly being a valid macro in t/utime.t
   (using Perl 5.26.1 for the regenerating, not 5.6.2)
   (thanks to Nigel Horne)
 - in t/utime.t define a nop sub done_testing for ancient Perls
   (like Perl 5.6.2)
 - in Perl 5.6.2 a bogus warning
   "Use of uninitialized value in subroutine entry"
   is issued from t/alarm.t: add a comment documenting that

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/fallback/const-xs.inc
dist/Time-HiRes/t/alarm.t
dist/Time-HiRes/t/utime.t

index 62dbf7e..e2391b0 100755 (executable)
@@ -1199,7 +1199,7 @@ use File::Glob qw(:case);
     },
 
     'Time::HiRes' => {
-        'DISTRIBUTION' => 'JHI/Time-HiRes-1.9750.tar.gz',
+        'DISTRIBUTION' => 'JHI/Time-HiRes-1.9752.tar.gz',
         'FILES'        => q[dist/Time-HiRes],
     },
 
index 5328dc0..e3d4541 100644 (file)
@@ -1,5 +1,35 @@
 Revision history for the Perl extension Time::HiRes.
 
+1.9752 [2018-01-04]
+ - fix an error in the error message of utimensat() not available:
+   it said futimens() not available
+ - add --force alias for Makefile.PL --configure
+
+1.9751 [2018-01-02]
+ - in macOS/OSX/Darwin, use __has_builtin() check also for utimensat(),
+   can cause errors like
+   "HiRes.xs:1474:16: error: unrecognized platform name macOS"
+   [rt.cpan.org #123994]
+   (oversight from 1.9749)
+ - do not define TIME_HIRES_STAT/d_hires_stat if none was found, instead
+   of defining it to be zero, which case has no implementation in hrstatns()
+   (thanks to Nigel Horne)
+ - in t/utime.t try to divine if the filesystem of the tempfiles has been
+   mounted with the 'noatime' option, which can prohibit updating the
+   access time timestamp.  Also document this in HiRes.pm.
+   (thanks to Nigel Horne, original analysis by Slaven Rezic)
+ - synchronize the constant lists in HiRes.pm:@EXPORT_OK
+   and Makefile.PL:doConstants and regenerate fallback/const-c.inc
+   and fallback/const-xs.inc, this fixes Perl 5.6.2 issue with
+   d_futimens not allegedly being a valid macro in t/utime.t
+   (using Perl 5.26.1 for the regenerating, not 5.6.2)
+   (thanks to Nigel Horne)
+ - in t/utime.t define a nop sub done_testing for ancient Perls
+   (like Perl 5.6.2)
+ - in Perl 5.6.2 a bogus warning
+   "Use of uninitialized value in subroutine entry"
+   is issued from t/alarm.t: add a comment documenting that
+
 1.9750 [2017-12-22]
  - update META.yml and META.json for XSLoader instead of DynaLoader
    [rt.cpan.org #123933]
index 8f01b5e..89d3ebb 100644 (file)
@@ -44,12 +44,13 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
                 ITIMER_VIRTUAL
                 TIMER_ABSTIME
                 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
-                d_nanosleep d_clock_gettime d_clock_getres d_hires_utime
-                d_clock d_clock_nanosleep
+                d_nanosleep d_clock_gettime d_clock_getres
+                d_clock d_clock_nanosleep d_hires_stat
+                d_futimens d_utimensat d_hires_utime
                 stat lstat utime
                );
 
-our $VERSION = '1.9750';
+our $VERSION = '1.9752';
 our $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -475,8 +476,10 @@ time stamp from t1: it may be equal or I<less>.
 
 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():
+in subsecond resolution, if the operating system and the filesystem,
+and the mount options of the filesystem, all support such timestamps.
+
+To override the standard utime():
 
     use Time::HiRes qw(utime);
 
@@ -489,6 +492,10 @@ call the syscall with a NULL argument.
 The actual achievable subsecond resolution depends on the combination
 of the operating system and the filesystem.
 
+Modifying the timestamps may not be possible at all: for example, the
+C<noatime> filesystem mount option may prohibit you from changing the
+access time timestamp.
+
 Returns the number of files successfully changed.
 
 =back
index 34c9db5..b9eaa17 100644 (file)
@@ -947,7 +947,7 @@ static int th_clock_nanosleep(clockid_t clock_id, int flags,
 # define FUTIMENS_AVAILABLE 0
 #endif
 #ifdef HAS_UTIMENSAT
-# ifdef PERL_DARWIN
+# if defined(PERL_DARWIN) && __has_builtin(__builtin_available)
 #  define UTIMENSAT_AVAILABLE __builtin_available(macOS 10.13, *)
 # else
 #  define UTIMENSAT_AVAILABLE 1
@@ -1479,7 +1479,7 @@ PROTOTYPE: $$@
                       tot++;
                     }
                   } else {
-                    croak("futimens unimplemented in this platform");
+                    croak("utimensat unimplemented in this platform");
                   }
 #else  /* HAS_UTIMENSAT */
                  croak("utimensat unimplemented in this platform");
index 02c193e..e0f7dd9 100644 (file)
@@ -1008,9 +1008,11 @@ sub doConstants {
                $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
            } elsif ($macro =~ /^(d_hires_stat)$/) {
                my $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;
+                if (defined $d_hires_stat) {
+                    push @names, {name => $_, macro => "TIME_HIRES_STAT", value => $d_hires_stat,
+                                  default => ["IV", "0"]};
+                    next;
+                }
            } elsif ($macro =~ /^(d_hires_utime)$/) {
                my $d_hires_utime =
                    ($DEFINE =~ /-DHAS_FUTIMENS/ ||
@@ -1049,9 +1051,11 @@ sub doConstants {
 }
 
 sub main {
-    if (-f "xdefine" && !(@ARGV  && $ARGV[0] eq '--configure')) {
+    if (-f "xdefine" && !(@ARGV  && $ARGV[0] =~ /^--(?:configure|force)$/)) {
        print qq[$0: The "xdefine" exists, skipping the configure step.\n];
-       print qq[("$^X $0 --configure" to force the configure step)\n];
+       print qq[Use "$^X $0 --configure"\n];
+       print qq[or: "$^X $0 --force\n];
+       print qq[to force the configure step.\n];
     } else {
        print "Configuring Time::HiRes...\n";
        1 while unlink("define");
index 524db16..2c29a0b 100644 (file)
@@ -24,7 +24,7 @@ static int
 constant_11 (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.
-     ITIMER_PROF ITIMER_REAL d_getitimer d_nanosleep d_setitimer */
+     ITIMER_PROF ITIMER_REAL d_getitimer d_nanosleep d_setitimer d_utimensat */
   /* Offset 7 gives the best switch position.  */
   switch (name[7]) {
   case 'P':
@@ -83,6 +83,63 @@ constant_11 (pTHX_ const char *name, IV *iv_return) {
 #endif
     }
     break;
+  case 'n':
+    if (memEQ(name, "d_utimensat", 11)) {
+    /*                      ^          */
+#ifdef HAS_UTIMENSAT
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_12 (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_SECOND CLOCK_UPTIME d_hires_stat */
+  /* Offset 10 gives the best switch position.  */
+  switch (name[10]) {
+  case 'M':
+    if (memEQ(name, "CLOCK_UPTIME", 12)) {
+    /*                         ^        */
+#ifdef CLOCK_UPTIME
+      *iv_return = CLOCK_UPTIME;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'N':
+    if (memEQ(name, "CLOCK_SECOND", 12)) {
+    /*                         ^        */
+#ifdef CLOCK_SECOND
+      *iv_return = CLOCK_SECOND;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'a':
+    if (memEQ(name, "d_hires_stat", 12)) {
+    /*                         ^        */
+#ifdef TIME_HIRES_STAT
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
   }
   return PERL_constant_NOTFOUND;
 }
@@ -91,12 +148,12 @@ 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)) {
-    /*                ^                  */
+     CLOCK_HIGHRES CLOCK_VIRTUAL TIMER_ABSTIME d_hires_utime */
+  /* Offset 12 gives the best switch position.  */
+  switch (name[12]) {
+  case 'E':
+    if (memEQ(name, "TIMER_ABSTIM", 12)) {
+    /*                           E      */
 #ifdef TIMER_ABSTIME
       *iv_return = TIMER_ABSTIME;
       return PERL_constant_ISIV;
@@ -106,8 +163,19 @@ constant_13 (pTHX_ const char *name, IV *iv_return) {
     }
     break;
   case 'L':
-    if (memEQ(name, "CLOCK_HIGHRES", 13)) {
-    /*                ^                  */
+    if (memEQ(name, "CLOCK_VIRTUA", 12)) {
+    /*                           L      */
+#ifdef CLOCK_VIRTUAL
+      *iv_return = CLOCK_VIRTUAL;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'S':
+    if (memEQ(name, "CLOCK_HIGHRE", 12)) {
+    /*                           S      */
 #ifdef CLOCK_HIGHRES
       *iv_return = CLOCK_HIGHRES;
       return PERL_constant_ISIV;
@@ -116,9 +184,9 @@ constant_13 (pTHX_ const char *name, IV *iv_return) {
 #endif
     }
     break;
-  case '_':
-    if (memEQ(name, "d_hires_utime", 13)) {
-    /*                ^                  */
+  case 'e':
+    if (memEQ(name, "d_hires_utim", 12)) {
+    /*                           e      */
 #ifdef TIME_HIRES_UTIME
       *iv_return = 1;
       return PERL_constant_ISIV;
@@ -136,8 +204,8 @@ 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.
-     CLOCKS_PER_SEC CLOCK_REALTIME CLOCK_SOFTTIME ITIMER_VIRTUAL d_clock_getres
-     d_gettimeofday */
+     CLOCKS_PER_SEC CLOCK_BOOTTIME CLOCK_REALTIME CLOCK_SOFTTIME ITIMER_VIRTUAL
+     d_clock_getres d_gettimeofday */
   /* Offset 8 gives the best switch position.  */
   switch (name[8]) {
   case 'A':
@@ -184,6 +252,17 @@ constant_14 (pTHX_ const char *name, IV *iv_return) {
 #endif
     }
     break;
+  case 'O':
+    if (memEQ(name, "CLOCK_BOOTTIME", 14)) {
+    /*                       ^            */
+#ifdef CLOCK_BOOTTIME
+      *iv_return = CLOCK_BOOTTIME;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
   case 'e':
     if (memEQ(name, "d_gettimeofday", 14)) {
     /*                       ^            */
@@ -269,6 +348,50 @@ constant_15 (pTHX_ const char *name, IV *iv_return) {
 }
 
 static int
+constant_19 (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_MONOTONIC_RAW CLOCK_REALTIME_FAST CLOCK_UPTIME_COARSE */
+  /* Offset 9 gives the best switch position.  */
+  switch (name[9]) {
+  case 'I':
+    if (memEQ(name, "CLOCK_UPTIME_COARSE", 19)) {
+    /*                        ^                */
+#ifdef CLOCK_UPTIME_COARSE
+      *iv_return = CLOCK_UPTIME_COARSE;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'L':
+    if (memEQ(name, "CLOCK_REALTIME_FAST", 19)) {
+    /*                        ^                */
+#ifdef CLOCK_REALTIME_FAST
+      *iv_return = CLOCK_REALTIME_FAST;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'O':
+    if (memEQ(name, "CLOCK_MONOTONIC_RAW", 19)) {
+    /*                        ^                */
+#ifdef CLOCK_MONOTONIC_RAW
+      *iv_return = CLOCK_MONOTONIC_RAW;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
 constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
   /* Initially switch on the length of the name.  */
   /* When generated this function returned values for the list of names given
@@ -281,18 +404,25 @@ constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
      Regenerate these constant functions by feeding this entire source file to
      perl -x
 
-#!perl -w
+#!/opt/local/perl-5.25.6/bin/perl -w
 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
 
 my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(CLOCKS_PER_SEC CLOCK_HIGHRES CLOCK_MONOTONIC
-              CLOCK_PROCESS_CPUTIME_ID CLOCK_REALTIME CLOCK_SOFTTIME
-              CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY ITIMER_PROF ITIMER_REAL
+my @names = (qw(CLOCKS_PER_SEC CLOCK_BOOTTIME CLOCK_HIGHRES CLOCK_MONOTONIC
+              CLOCK_MONOTONIC_COARSE CLOCK_MONOTONIC_FAST
+              CLOCK_MONOTONIC_PRECISE CLOCK_MONOTONIC_RAW
+              CLOCK_PROCESS_CPUTIME_ID CLOCK_PROF CLOCK_REALTIME
+              CLOCK_REALTIME_COARSE CLOCK_REALTIME_FAST CLOCK_REALTIME_PRECISE
+              CLOCK_REALTIME_RAW CLOCK_SECOND CLOCK_SOFTTIME
+              CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY CLOCK_UPTIME
+              CLOCK_UPTIME_COARSE CLOCK_UPTIME_FAST CLOCK_UPTIME_PRECISE
+              CLOCK_UPTIME_RAW CLOCK_VIRTUAL ITIMER_PROF ITIMER_REAL
               ITIMER_REALPROF ITIMER_VIRTUAL TIMER_ABSTIME),
             {name=>"d_clock", type=>"IV", macro=>"TIME_HIRES_CLOCK", value=>"1", default=>["IV", "0"]},
             {name=>"d_clock_getres", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETRES", value=>"1", default=>["IV", "0"]},
             {name=>"d_clock_gettime", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETTIME", value=>"1", default=>["IV", "0"]},
             {name=>"d_clock_nanosleep", type=>"IV", macro=>"TIME_HIRES_CLOCK_NANOSLEEP", value=>"1", default=>["IV", "0"]},
+            {name=>"d_futimens", type=>"IV", macro=>"HAS_FUTIMENS", value=>"1", default=>["IV", "0"]},
             {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"]},
@@ -300,7 +430,8 @@ my @names = (qw(CLOCKS_PER_SEC CLOCK_HIGHRES CLOCK_MONOTONIC
             {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"]});
+            {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]},
+            {name=>"d_utimensat", type=>"IV", macro=>"HAS_UTIMENSAT", value=>"1", default=>["IV", "0"]});
 
 print constant_types(), "\n"; # macro defs
 foreach (C_constant ("Time::HiRes", 'constant', 'IV', $types, undef, 3, @names) ) {
@@ -354,19 +485,41 @@ __END__
       break;
     }
     break;
+  case 10:
+    /* Names all of length 10.  */
+    /* CLOCK_PROF d_futimens */
+    /* Offset 5 gives the best switch position.  */
+    switch (name[5]) {
+    case '_':
+      if (memEQ(name, "CLOCK_PROF", 10)) {
+      /*                    ^           */
+#ifdef CLOCK_PROF
+        *iv_return = CLOCK_PROF;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'i':
+      if (memEQ(name, "d_futimens", 10)) {
+      /*                    ^           */
+#ifdef HAS_FUTIMENS
+        *iv_return = 1;
+        return PERL_constant_ISIV;
+#else
+        *iv_return = 0;
+        return PERL_constant_ISIV;
+#endif
+      }
+      break;
+    }
+    break;
   case 11:
     return constant_11 (aTHX_ name, iv_return);
     break;
   case 12:
-    if (memEQ(name, "d_hires_stat", 12)) {
-#ifdef TIME_HIRES_STAT
-      *iv_return = 1;
-      return PERL_constant_ISIV;
-#else
-      *iv_return = 0;
-      return PERL_constant_ISIV;
-#endif
-    }
+    return constant_12 (aTHX_ name, iv_return);
     break;
   case 13:
     return constant_13 (aTHX_ name, iv_return);
@@ -377,25 +530,154 @@ __END__
   case 15:
     return constant_15 (aTHX_ name, iv_return);
     break;
+  case 16:
+    if (memEQ(name, "CLOCK_UPTIME_RAW", 16)) {
+#ifdef CLOCK_UPTIME_RAW
+      *iv_return = CLOCK_UPTIME_RAW;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
   case 17:
-    if (memEQ(name, "d_clock_nanosleep", 17)) {
+    /* Names all of length 17.  */
+    /* CLOCK_UPTIME_FAST d_clock_nanosleep */
+    /* Offset 5 gives the best switch position.  */
+    switch (name[5]) {
+    case '_':
+      if (memEQ(name, "CLOCK_UPTIME_FAST", 17)) {
+      /*                    ^                  */
+#ifdef CLOCK_UPTIME_FAST
+        *iv_return = CLOCK_UPTIME_FAST;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'c':
+      if (memEQ(name, "d_clock_nanosleep", 17)) {
+      /*                    ^                  */
 #ifdef TIME_HIRES_CLOCK_NANOSLEEP
-      *iv_return = 1;
+        *iv_return = 1;
+        return PERL_constant_ISIV;
+#else
+        *iv_return = 0;
+        return PERL_constant_ISIV;
+#endif
+      }
+      break;
+    }
+    break;
+  case 18:
+    if (memEQ(name, "CLOCK_REALTIME_RAW", 18)) {
+#ifdef CLOCK_REALTIME_RAW
+      *iv_return = CLOCK_REALTIME_RAW;
       return PERL_constant_ISIV;
 #else
-      *iv_return = 0;
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 19:
+    return constant_19 (aTHX_ name, iv_return);
+    break;
+  case 20:
+    /* Names all of length 20.  */
+    /* CLOCK_MONOTONIC_FAST CLOCK_UPTIME_PRECISE */
+    /* Offset 7 gives the best switch position.  */
+    switch (name[7]) {
+    case 'O':
+      if (memEQ(name, "CLOCK_MONOTONIC_FAST", 20)) {
+      /*                      ^                   */
+#ifdef CLOCK_MONOTONIC_FAST
+        *iv_return = CLOCK_MONOTONIC_FAST;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'P':
+      if (memEQ(name, "CLOCK_UPTIME_PRECISE", 20)) {
+      /*                      ^                   */
+#ifdef CLOCK_UPTIME_PRECISE
+        *iv_return = CLOCK_UPTIME_PRECISE;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    }
+    break;
+  case 21:
+    if (memEQ(name, "CLOCK_REALTIME_COARSE", 21)) {
+#ifdef CLOCK_REALTIME_COARSE
+      *iv_return = CLOCK_REALTIME_COARSE;
       return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
 #endif
     }
     break;
+  case 22:
+    /* Names all of length 22.  */
+    /* CLOCK_MONOTONIC_COARSE CLOCK_REALTIME_PRECISE */
+    /* Offset 12 gives the best switch position.  */
+    switch (name[12]) {
+    case 'M':
+      if (memEQ(name, "CLOCK_REALTIME_PRECISE", 22)) {
+      /*                           ^                */
+#ifdef CLOCK_REALTIME_PRECISE
+        *iv_return = CLOCK_REALTIME_PRECISE;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'N':
+      if (memEQ(name, "CLOCK_MONOTONIC_COARSE", 22)) {
+      /*                           ^                */
+#ifdef CLOCK_MONOTONIC_COARSE
+        *iv_return = CLOCK_MONOTONIC_COARSE;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    }
+    break;
   case 23:
-    if (memEQ(name, "CLOCK_THREAD_CPUTIME_ID", 23)) {
+    /* Names all of length 23.  */
+    /* CLOCK_MONOTONIC_PRECISE CLOCK_THREAD_CPUTIME_ID */
+    /* Offset 22 gives the best switch position.  */
+    switch (name[22]) {
+    case 'D':
+      if (memEQ(name, "CLOCK_THREAD_CPUTIME_I", 22)) {
+      /*                                     D      */
 #ifdef CLOCK_THREAD_CPUTIME_ID
-      *iv_return = CLOCK_THREAD_CPUTIME_ID;
-      return PERL_constant_ISIV;
+        *iv_return = CLOCK_THREAD_CPUTIME_ID;
+        return PERL_constant_ISIV;
 #else
-      return PERL_constant_NOTDEF;
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'E':
+      if (memEQ(name, "CLOCK_MONOTONIC_PRECIS", 22)) {
+      /*                                     E      */
+#ifdef CLOCK_MONOTONIC_PRECISE
+        *iv_return = CLOCK_MONOTONIC_PRECISE;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
 #endif
+      }
+      break;
     }
     break;
   case 24:
index c84dd05..b8c10a9 100644 (file)
@@ -22,12 +22,14 @@ constant(sv)
            Second, if present, is found value */
         switch (type) {
         case PERL_constant_NOTFOUND:
-          sv = sv_2mortal(newSVpvf("%s is not a valid Time::HiRes macro", s));
+          sv =
+           sv_2mortal(newSVpvf("%s is not a valid Time::HiRes macro", s));
           PUSHs(sv);
           break;
         case PERL_constant_NOTDEF:
           sv = sv_2mortal(newSVpvf(
-           "Your vendor has not defined Time::HiRes macro %s, used", s));
+           "Your vendor has not defined Time::HiRes macro %s, used",
+                                  s));
           PUSHs(sv);
           break;
         case PERL_constant_ISIV:
index 7bdc6da..af34d2a 100644 (file)
@@ -42,6 +42,9 @@ SKIP: {
        # Perl's deferred signals may be too wimpy to break through
        # a restartable select(), so use POSIX::sigaction if available.
 
+        # In perl 5.6.2 you will get a likely bogus warning of
+        # "Use of uninitialized value in subroutine entry" from
+        # the following line.
        POSIX::sigaction(&POSIX::SIGALRM,
                         POSIX::SigAction->new("tick"),
                         $oldaction)
index c404ec3..e03c366 100644 (file)
@@ -5,7 +5,7 @@ sub has_subsecond_file_times {
   require Time::HiRes;
   my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" );
   use File::Basename qw[dirname];
-  my $dirname =  dirname($filename);
+  my $dirname = dirname($filename);
   require Cwd;
   $dirname = &Cwd::getcwd if $dirname eq '.';
   print("\n# Testing for subsecond file timestamps (mtime) in $dirname\n");
@@ -27,6 +27,66 @@ sub has_subsecond_file_times {
   return $ok;
 }
 
+sub get_filesys_of_tempfile {
+  require File::Temp;
+  require Time::HiRes;
+  my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" );
+  my $filesys;
+  if (open(my $df, "df $filename |")) {
+    my @fs;
+    while (<$df>) {
+      next if /^Filesystem/;
+      chomp;
+      push @fs, $_;
+    }
+    if (@fs == 1) {
+      if (defined $fs[0] && length($fs[0])) {
+        $filesys = $fs[0];
+      } else {
+        printf("# Got empty result from 'df'\n");
+      }
+    } else {
+      printf("# Expected one result from 'df', got %d\n", scalar(@fs));
+    }
+  } else {
+    # Too noisy to show by default.
+    # Can fail for too many reasons.
+    print "# Failed to run 'df $filename |': $!\n";
+  }
+  return $filesys;
+}
+
+sub get_mount_of_filesys {
+  my ($filesys) = @_;
+  if (defined $filesys) {
+    my @fs = split(' ', $filesys);
+    if (open(my $mount, "mount |")) {
+      while (<$mount>) {
+        chomp;
+        my @mnt = split(' ');
+        if ($mnt[0] eq $fs[0]) {
+          return $_;
+        }
+      }
+    } else {
+      # Too noisy to show by default.
+      # The mount(8) might not be in the PATH, for example.
+      # Or this might be a completely non-UNIX system.
+      # print "# Failed to run 'mount |': $!\n";
+    }
+  }
+  return;
+}
+
+sub get_mount_of_tempfile {
+  return get_mount_of_filesys(get_filesys_of_tempfile());
+}
+
+sub tempfile_has_noatime_mount {
+  my ($mount) = get_mount_of_tempfile();
+  return $mount =~ /\bnoatime\b/;
+}
+
 BEGIN {
     require Time::HiRes;
     require Test::More;
@@ -55,6 +115,10 @@ BEGIN { push @INC, '.' }
 use t::Watchdog;
 use File::Temp qw( tempfile );
 
+BEGIN {
+  *done_testing = sub {} unless defined &done_testing;
+}
+
 use Config;
 
 # Hope initially for nanosecond accuracy.
@@ -68,12 +132,21 @@ if ($^O eq 'cygwin') {
 }
 print "# \$^O = $^O, atime = $atime, mtime = $mtime\n";
 
+my $skip_atime = $^O eq 'netbsd' && tempfile_has_noatime_mount();
+
+if ($skip_atime) {
+  printf("# Skipping atime tests because tempfiles seem to be in a filesystem mounted with 'noatime' ($^O)\n'");
+}
+
 print "# utime \$fh\n";
 {
        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";
+        SKIP: {
+          skip("noatime mount", 1) if $skip_atime;
+          is $got_atime, $atime, "atime set correctly";
+        }
        is $got_mtime, $mtime, "mtime set correctly";
 };
 
@@ -82,7 +155,10 @@ print "#utime \$filename\n";
        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";
+        SKIP: {
+            skip("noatime mount", 1) if $skip_atime;
+            is $got_atime, $atime, "atime set correctly";
+        }
        is $got_mtime, $mtime, "mtime set correctly";
 };
 
@@ -93,12 +169,18 @@ print "utime \$filename and \$fh\n";
        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";
+                SKIP: {
+                    skip("noatime mount", 1) if $skip_atime;
+                    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";
+                SKIP: {
+                    skip("noatime mount", 1) if $skip_atime;
+                    is $got_atime, $atime, "File 2 atime set correctly";
+                }
                is $got_mtime, $mtime, "File 2 mtime set correctly";
        }
 };
@@ -114,12 +196,18 @@ print "# utime undef sets time to now\n";
 
        {
                my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9];
-               cmp_ok $got_atime, '>=', $now, "File 1 atime set correctly";
+                SKIP: {
+                    skip("noatime mount", 1) if $skip_atime;
+                    cmp_ok $got_atime, '>=', $now, "File 1 atime set correctly";
+                }
                cmp_ok $got_mtime, '>=', $now, "File 1 mtime set correctly";
        }
        {
                my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9];
-               cmp_ok $got_atime, '>=', $now, "File 2 atime set correctly";
+                SKIP: {
+                    skip("noatime mount", 1) if $skip_atime;
+                    cmp_ok $got_atime, '>=', $now, "File 2 atime set correctly";
+                }
                cmp_ok $got_mtime, '>=', $now, "File 2 mtime set correctly";
        }
 };
@@ -138,6 +226,6 @@ print "# negative mtime dies;\n";
                "negative time error";
 };
 
-done_testing;
+done_testing();
 
 1;