use strict; BEGIN { require Time::HiRes; require Test::More; require File::Temp; unless(&Time::HiRes::d_hires_utime) { Test::More::plan(skip_all => "no hires_utime"); } unless (&Time::HiRes::d_futimens) { Test::More::plan(skip_all => "no futimens()"); } unless (&Time::HiRes::d_utimensat) { Test::More::plan(skip_all => "no utimensat()"); } if ($^O eq 'gnukfreebsd') { Test::More::plan(skip_all => "futimens() and utimensat() not working in $^O"); } if ($^O eq 'linux' && -e '/proc/mounts') { # The linux might be wrong when ext3 # is available in other operating systems, # but then we need other methods for detecting # the filesystem type of the tempfiles. my ($fh, $fn) = File::Temp::tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1); sub getfstype { my ($fn) = @_; my $cmd = "df $fn"; open(my $df, '-|', $cmd) or die "$cmd: $!"; my @df = <$df>; # Assume $df[0] is header line. my $dev = +(split(" ", $df[1]))[0]; open(my $mounts, '<', '/proc/mounts') or die "/proc/mounts: $!"; while (<$mounts>) { my @m = split(" "); if ($m[0] eq $dev) { return $m[2] } } return; } my $fstype = getfstype($fn); unless (defined $fstype) { warn "Unknown fstype for $fn\n"; } else { print "# fstype = $fstype\n"; if ($fstype eq 'ext3' || $fstype eq 'ext2') { Test::More::plan(skip_all => "fstype $fstype has no subsecond timestamps in $^O"); } } } } use Test::More tests => 18; BEGIN { push @INC, '.' } use t::Watchdog; use File::Temp qw( tempfile ); use Config; # Hope initially for nanosecond accuracy. my $atime = 1.111111111; my $mtime = 2.222222222; if ($^O eq 'cygwin') { # Cygwin timestamps have less precision. $atime = 1.1111111; $mtime = 2.2222222; } print "# \$^O = $^O, atime = $atime, mtime = $mtime\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"; is $got_mtime, $mtime, "mtime set correctly"; }; 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"; is $got_mtime, $mtime, "mtime set correctly"; }; print "utime \$filename and \$fh\n"; { 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"; } }; print "# utime undef sets time to now\n"; { 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"; } }; print "# negative atime dies\n"; { eval { Time::HiRes::utime(-4, $mtime) }; like $@, qr/::utime\(-4, 2\.22222\): negative time not invented yet/, "negative time error"; }; print "# negative mtime dies;\n"; { eval { Time::HiRes::utime($atime, -4) }; like $@, qr/::utime\(1.11111, -4\): negative time not invented yet/, "negative time error"; }; done_testing; 1;