1use strict; 2 3BEGIN { 4 require Time::HiRes; 5 unless(&Time::HiRes::d_hires_stat) { 6 require Test::More; 7 Test::More::plan(skip_all => "no hi-res stat"); 8 } 9 if($^O =~ /\A(?:cygwin|MSWin)/) { 10 require Test::More; 11 Test::More::plan(skip_all => 12 "$^O file timestamps not reliable enough for stat test"); 13 } 14} 15 16use Test::More tests => 43; 17BEGIN { push @INC, '.' } 18use t::Watchdog; 19 20my @atime; 21my @mtime; 22for (1..5) { 23 note "cycle $_"; 24 Time::HiRes::sleep(rand(0.1) + 0.1); 25 open(X, '>', $$); 26 print X $$; 27 close(X); 28 my($a, $stat, $b) = ("a", [Time::HiRes::stat($$)], "b"); 29 is $a, "a", "stat stack discipline"; 30 is $b, "b", "stat stack discipline"; 31 is ref($stat), "ARRAY", "stat returned array"; 32 push @mtime, $stat->[9]; 33 ($a, my $lstat, $b) = ("a", [Time::HiRes::lstat($$)], "b"); 34 is $a, "a", "lstat stack discipline"; 35 is $b, "b", "lstat stack discipline"; 36 SKIP: { 37 if($^O eq "haiku") { 38 skip "testing stat access time on Haiku", 2; 39 } 40 if ($ENV{PERL_FILE_ATIME_CHANGES}) { 41 # something else might access the file, changing atime 42 $lstat->[8] = $stat->[8]; 43 } 44 is_deeply $lstat, $stat, "write: stat and lstat returned same values"; 45 Time::HiRes::sleep(rand(0.1) + 0.1); 46 open(X, '<', $$); 47 <X>; 48 close(X); 49 $stat = [Time::HiRes::stat($$)]; 50 push @atime, $stat->[8]; 51 $lstat = [Time::HiRes::lstat($$)]; 52 is_deeply $lstat, $stat, "read: stat and lstat returned same values"; 53 } 54} 551 while unlink $$; 56note ("mtime = @mtime"); 57note ("atime = @atime"); 58my $ai = 0; 59my $mi = 0; 60my $ss = 0; 61for (my $i = 1; $i < @atime; $i++) { 62 if ($atime[$i] >= $atime[$i-1]) { 63 $ai++; 64 } 65 if ($atime[$i] > int($atime[$i])) { 66 $ss++; 67 } 68} 69for (my $i = 1; $i < @mtime; $i++) { 70 if ($mtime[$i] >= $mtime[$i-1]) { 71 $mi++; 72 } 73 if ($mtime[$i] > int($mtime[$i])) { 74 $ss++; 75 } 76} 77note ("ai = $ai, mi = $mi, ss = $ss"); 78# Need at least 75% of monotonical increase and 79# 20% of subsecond results. Yes, this is guessing. 80SKIP: { 81 skip "no subsecond timestamps detected", 1 if $ss == 0; 82 skip "testing stat access on Haiku", 1 if $^O eq "haiku"; 83 ok $mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 && 84 $ss/(@mtime+@atime) >= 0.2, 85 "monotonical increase and subsecond results within expected parameters"; 86} 87 88my $targetname = "tgt$$"; 89my $linkname = "link$$"; 90SKIP: { 91 open(X, '>', $targetname); 92 print X $$; 93 close(X); 94 eval { symlink $targetname, $linkname or die "can't symlink: $!"; }; 95 skip "can't symlink", 7 if $@ ne ""; 96 note "compare Time::HiRes::stat with ::lstat"; 97 my @tgt_stat = Time::HiRes::stat($targetname); 98 my @tgt_lstat = Time::HiRes::lstat($targetname); 99 my @lnk_stat = Time::HiRes::stat($linkname); 100 my @lnk_lstat = Time::HiRes::lstat($linkname); 101 my $exp = 13; 102 is scalar(@tgt_stat), $exp, "stat on target"; 103 is scalar(@tgt_lstat), $exp, "lstat on target"; 104 is scalar(@lnk_stat), $exp, "stat on link"; 105 is scalar(@lnk_lstat), $exp, "lstat on link"; 106 skip "testing stat access on Haiku", 3 if $^O eq "haiku"; 107 is_deeply \@tgt_stat, \@tgt_lstat, "stat and lstat return same values on target"; 108 is_deeply \@tgt_stat, \@lnk_stat, "stat and lstat return same values on link"; 109 isnt $lnk_lstat[2], $tgt_stat[2], 110 "target stat mode value differs from link lstat mode value"; 111} 1121 while unlink $linkname; 1131 while unlink $targetname; 114 1151; 116