3 sub has_subsecond_file_times {
6 my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" );
7 use File::Basename qw[dirname];
8 my $dirname = dirname($filename);
10 $dirname = &Cwd::getcwd if $dirname eq '.';
11 print("\n# Testing for subsecond file timestamps (mtime) in $dirname\n");
15 open $fh, '>', $filename;
18 push @mtimes, (Time::HiRes::stat($filename))[9];
19 Time::HiRes::sleep(.1) if $_ == 1;
21 my $delta = $mtimes[1] - $mtimes[0];
22 # print STDERR "mtimes = @mtimes, delta = $delta\n";
24 my $ok = $delta > 0 && $delta < 1;
25 printf("# Subsecond file timestamps in $dirname: %s\n",
30 sub get_filesys_of_tempfile {
33 my ($fh, $filename) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX" );
35 if (open(my $df, "df $filename |")) {
38 next if /^Filesystem/;
43 if (defined $fs[0] && length($fs[0])) {
46 printf("# Got empty result from 'df'\n");
49 printf("# Expected one result from 'df', got %d\n", scalar(@fs));
52 # Too noisy to show by default.
53 # Can fail for too many reasons.
54 print "# Failed to run 'df $filename |': $!\n";
59 sub get_mount_of_filesys {
61 if (defined $filesys) {
62 my @fs = split(' ', $filesys);
63 if (open(my $mount, "mount |")) {
67 if ($mnt[0] eq $fs[0]) {
72 # Too noisy to show by default.
73 # The mount(8) might not be in the PATH, for example.
74 # Or this might be a completely non-UNIX system.
75 # print "# Failed to run 'mount |': $!\n";
81 sub get_mount_of_tempfile {
82 return get_mount_of_filesys(get_filesys_of_tempfile());
85 sub tempfile_has_noatime_mount {
86 my ($mount) = get_mount_of_tempfile();
87 return $mount =~ /\bnoatime\b/;
94 unless(&Time::HiRes::d_hires_utime) {
95 Test::More::plan(skip_all => "no hires_utime");
97 unless(&Time::HiRes::d_hires_stat) {
98 # Being able to read subsecond timestamps is a reasonable
99 # prerequisite for being able to write them.
100 Test::More::plan(skip_all => "no hires_stat");
102 unless (&Time::HiRes::d_futimens) {
103 Test::More::plan(skip_all => "no futimens()");
105 unless (&Time::HiRes::d_utimensat) {
106 Test::More::plan(skip_all => "no utimensat()");
108 unless (has_subsecond_file_times()) {
109 Test::More::plan(skip_all => "No subsecond file timestamps");
113 use Test::More tests => 18;
114 BEGIN { push @INC, '.' }
116 use File::Temp qw( tempfile );
119 *done_testing = sub {} unless defined &done_testing;
124 # Hope initially for nanosecond accuracy.
125 my $atime = 1.111111111;
126 my $mtime = 2.222222222;
128 if ($^O eq 'cygwin') {
129 # Cygwin timestamps have less precision.
133 print "# \$^O = $^O, atime = $atime, mtime = $mtime\n";
135 my $skip_atime = $^O eq 'netbsd' && tempfile_has_noatime_mount();
138 printf("# Skipping atime tests because tempfiles seem to be in a filesystem mounted with 'noatime' ($^O)\n'");
141 print "# utime \$fh\n";
143 my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
144 is Time::HiRes::utime($atime, $mtime, $fh), 1, "One file changed";
145 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename) )[8, 9];
147 skip("noatime mount", 1) if $skip_atime;
148 is $got_atime, $atime, "atime set correctly";
150 is $got_mtime, $mtime, "mtime set correctly";
153 print "#utime \$filename\n";
155 my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
156 is Time::HiRes::utime($atime, $mtime, $filename), 1, "One file changed";
157 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9];
159 skip("noatime mount", 1) if $skip_atime;
160 is $got_atime, $atime, "atime set correctly";
162 is $got_mtime, $mtime, "mtime set correctly";
165 print "utime \$filename and \$fh\n";
167 my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
168 my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
169 is Time::HiRes::utime($atime, $mtime, $filename1, $fh2), 2, "Two files changed";
171 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9];
173 skip("noatime mount", 1) if $skip_atime;
174 is $got_atime, $atime, "File 1 atime set correctly";
176 is $got_mtime, $mtime, "File 1 mtime set correctly";
179 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9];
181 skip("noatime mount", 1) if $skip_atime;
182 is $got_atime, $atime, "File 2 atime set correctly";
184 is $got_mtime, $mtime, "File 2 mtime set correctly";
188 print "# utime undef sets time to now\n";
190 my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
191 my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 );
193 my $now = Time::HiRes::time;
195 is Time::HiRes::utime(undef, undef, $filename1, $fh2), 2, "Two files changed";
198 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9];
200 skip("noatime mount", 1) if $skip_atime;
201 cmp_ok $got_atime, '>=', $now, "File 1 atime set correctly";
203 cmp_ok $got_mtime, '>=', $now, "File 1 mtime set correctly";
206 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9];
208 skip("noatime mount", 1) if $skip_atime;
209 cmp_ok $got_atime, '>=', $now, "File 2 atime set correctly";
211 cmp_ok $got_mtime, '>=', $now, "File 2 mtime set correctly";
215 print "# negative atime dies\n";
217 eval { Time::HiRes::utime(-4, $mtime) };
218 like $@, qr/::utime\(-4, 2\.22222\): negative time not invented yet/,
219 "negative time error";
222 print "# negative mtime dies;\n";
224 eval { Time::HiRes::utime($atime, -4) };
225 like $@, qr/::utime\(1.11111, -4\): negative time not invented yet/,
226 "negative time error";