dist/Time-HiRes/t/stat.t

   1 use strict;
   2
   3 BEGIN {
   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
  16 use Test::More 0.82 tests => 43;
  17 use t::Watchdog;
  18
  19 my $limit = 0.25; # 25% is acceptable slosh for testing timers
  20
  21 my @atime;
  22 my @mtime;
  23 for (1..5) {
  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";
  30     is $b, "b";
  31     is ref($stat), "ARRAY";
  32     push @mtime, $stat->[9];
  33     ($a, my $lstat, $b) = ("a", [Time::HiRes::lstat($$)], "b");
  34     is $a, "a";
  35     is $b, "b";
  36     is_deeply $lstat, $stat;
  37     Time::HiRes::sleep(rand(0.1) + 0.1);
  38     open(X, "<$$");
  39     <X>;
  40     close(X);
  41     $stat = [Time::HiRes::stat($$)];
  42     push @atime, $stat->[8];
  43     $lstat = [Time::HiRes::lstat($$)];
  44     is_deeply $lstat, $stat;
  45 }
  46 1 while unlink $$;
  47 note "mtime = @mtime";
  48 note "atime = @atime";
  49 my $ai = 0;
  50 my $mi = 0;
  51 my $ss = 0;
  52 for (my $i = 1; $i < @atime; $i++) {
  53     if ($atime[$i] >= $atime[$i-1]) {
  54         $ai++;
  55     }
  56     if ($atime[$i] > int($atime[$i])) {
  57         $ss++;
  58     }
  59 }
  60 for (my $i = 1; $i < @mtime; $i++) {
  61     if ($mtime[$i] >= $mtime[$i-1]) {
  62         $mi++;
  63     }
  64     if ($mtime[$i] > int($mtime[$i])) {
  65         $ss++;
  66     }
  67 }
  68 note "ai = $ai, mi = $mi, ss = $ss";
  69 # Need at least 75% of monotonical increase and
  70 # 20% of subsecond results. Yes, this is guessing.
  71 SKIP: {
  72     skip "no subsecond timestamps detected", 1 if $ss == 0;
  73     ok $mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 &&
  74              $ss/(@mtime+@atime) >= 0.2;
  75 }
  76
  77 my $targetname = "tgt$$";
  78 my $linkname = "link$$";
  79 SKIP: {
  80     open(X, ">$targetname");
  81     print X $$;
  82     close(X);
  83     eval { symlink $targetname, $linkname or die "can't symlink: $!"; };
  84     skip "can't symlink", 7 if $@ ne "";
  85     my @tgt_stat = Time::HiRes::stat($targetname);
  86     my @tgt_lstat = Time::HiRes::lstat($targetname);
  87     my @lnk_stat = Time::HiRes::stat($linkname);
  88     my @lnk_lstat = Time::HiRes::lstat($linkname);
  89     is scalar(@tgt_stat), 13;
  90     is scalar(@tgt_lstat), 13;
  91     is scalar(@lnk_stat), 13;
  92     is scalar(@lnk_lstat), 13;
  93     is_deeply \@tgt_stat, \@tgt_lstat;
  94     is_deeply \@tgt_stat, \@lnk_stat;
  95     isnt $lnk_lstat[2], $tgt_stat[2];
  96 }
  97 1 while unlink $linkname;
  98 1 while unlink $targetname;
  99
 100 1;