Update Time-HiRes to CPAN version 1.9752

[perl5.git] / dist / Time-HiRes / t / utime.t

diff --git a/dist/Time-HiRes/t/utime.t b/dist/Time-HiRes/t/utime.t
index c404ec3..e03c366 100644 (file)
--- a/dist/Time-HiRes/t/utime.t
+++ b/dist/Time-HiRes/t/utime.t
@@ -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;