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