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");
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;
use t::Watchdog;
use File::Temp qw( tempfile );
+BEGIN {
+ *done_testing = sub {} unless defined &done_testing;
+}
+
use Config;
# Hope initially for nanosecond accuracy.
}
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";
};
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";
};
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";
}
};
{
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";
}
};
"negative time error";
};
-done_testing;
+done_testing();
1;