1use strict; 2 3BEGIN { 4 require Time::HiRes; 5 require Test::More; 6 unless(&Time::HiRes::d_hires_utime) { 7 Test::More::plan(skip_all => "no hires_utime"); 8 } 9 unless (&Time::HiRes::d_futimens) { 10 Test::More::plan(skip_all => "no futimens()"); 11 } 12 unless (&Time::HiRes::d_utimensat) { 13 Test::More::plan(skip_all => "no utimensat()"); 14 } 15 if ($^O eq 'gnukfreebsd') { 16 Test::More::plan(skip_all => "futimens() and utimensat() not working in $^O"); 17 } 18} 19 20use Test::More tests => 18; 21use t::Watchdog; 22use File::Temp qw( tempfile ); 23 24use Config; 25 26# Cygwin timestamps have less precision. 27my $atime = $^O eq 'cygwin' ? 1.1111111 : 1.111111111; 28my $mtime = $^O eq 'cygwin' ? 2.2222222 : 2.222222222; 29 30print "# utime \$fh\n"; 31{ 32 my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); 33 is Time::HiRes::utime($atime, $mtime, $fh), 1, "One file changed"; 34 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename) )[8, 9]; 35 is $got_atime, $atime, "atime set correctly"; 36 is $got_mtime, $mtime, "mtime set correctly"; 37}; 38 39print "#utime \$filename\n"; 40{ 41 my ($fh, $filename) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); 42 is Time::HiRes::utime($atime, $mtime, $filename), 1, "One file changed"; 43 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh) )[8, 9]; 44 is $got_atime, $atime, "atime set correctly"; 45 is $got_mtime, $mtime, "mtime set correctly"; 46}; 47 48print "utime \$filename and \$fh\n"; 49{ 50 my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); 51 my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); 52 is Time::HiRes::utime($atime, $mtime, $filename1, $fh2), 2, "Two files changed"; 53 { 54 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9]; 55 is $got_atime, $atime, "File 1 atime set correctly"; 56 is $got_mtime, $mtime, "File 1 mtime set correctly"; 57 } 58 { 59 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9]; 60 is $got_atime, $atime, "File 2 atime set correctly"; 61 is $got_mtime, $mtime, "File 2 mtime set correctly"; 62 } 63}; 64 65print "# utime undef sets time to now\n"; 66{ 67 my ($fh1, $filename1) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); 68 my ($fh2, $filename2) = tempfile( "Time-HiRes-utime-XXXXXXXXX", UNLINK => 1 ); 69 70 my $now = Time::HiRes::time; 71 is Time::HiRes::utime(undef, undef, $filename1, $fh2), 2, "Two files changed"; 72 73 { 74 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($fh1) )[8, 9]; 75 cmp_ok abs( $got_atime - $now), '<', 0.1, "File 1 atime set correctly"; 76 cmp_ok abs( $got_mtime - $now), '<', 0.1, "File 1 mtime set correctly"; 77 } 78 { 79 my ($got_atime, $got_mtime) = ( Time::HiRes::stat($filename2) )[8, 9]; 80 cmp_ok abs( $got_atime - $now), '<', 0.1, "File 2 atime set correctly"; 81 cmp_ok abs( $got_mtime - $now), '<', 0.1, "File 2 mtime set correctly"; 82 } 83}; 84 85print "# negative atime dies\n"; 86{ 87 eval { Time::HiRes::utime(-4, $mtime) }; 88 like $@, qr/::utime\(-4, 2\.22222\): negative time not invented yet/, 89 "negative time error"; 90}; 91 92print "# negative mtime dies;\n"; 93{ 94 eval { Time::HiRes::utime($atime, -4) }; 95 like $@, qr/::utime\(1.11111, -4\): negative time not invented yet/, 96 "negative time error"; 97}; 98 99done_testing; 100 1011; 102