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