diff options
author | Thibault Duponchelle <thibault.duponchelle@gmail.com> | 2021-07-06 16:31:12 +0000 |
---|---|---|
committer | Leon Timmermans <fawaka@gmail.com> | 2021-07-13 20:51:34 +0200 |
commit | 7ffb9e762a2e972f46cd37962bd0aae40a4e7e3b (patch) | |
tree | d9e88317b35dba5271c4840c90605bc48a38b51b | |
parent | c9d678845a114f97048519e9c564b342b08ccfd2 (diff) | |
download | perl-7ffb9e762a2e972f46cd37962bd0aae40a4e7e3b.tar.gz |
Haiku BFS does not store atime and always return current time
-rw-r--r-- | dist/Time-HiRes/HiRes.pm | 2 | ||||
-rw-r--r-- | dist/Time-HiRes/t/stat.t | 25 | ||||
-rw-r--r-- | lib/File/stat.pm | 2 | ||||
-rw-r--r-- | lib/File/stat.t | 20 |
4 files changed, 32 insertions, 17 deletions
diff --git a/dist/Time-HiRes/HiRes.pm b/dist/Time-HiRes/HiRes.pm index 9377c3479f..c75f5cd288 100644 --- a/dist/Time-HiRes/HiRes.pm +++ b/dist/Time-HiRes/HiRes.pm @@ -50,7 +50,7 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval stat lstat utime ); -our $VERSION = '1.9767'; +our $VERSION = '1.9768'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; diff --git a/dist/Time-HiRes/t/stat.t b/dist/Time-HiRes/t/stat.t index f2f8e87751..1c16c26254 100644 --- a/dist/Time-HiRes/t/stat.t +++ b/dist/Time-HiRes/t/stat.t @@ -32,15 +32,20 @@ for (1..5) { ($a, my $lstat, $b) = ("a", [Time::HiRes::lstat($$)], "b"); is $a, "a"; is $b, "b"; - is_deeply $lstat, $stat; - Time::HiRes::sleep(rand(0.1) + 0.1); - open(X, '<', $$); - <X>; - close(X); - $stat = [Time::HiRes::stat($$)]; - push @atime, $stat->[8]; - $lstat = [Time::HiRes::lstat($$)]; - is_deeply $lstat, $stat; + SKIP: { + if($^O eq "haiku") { + skip "testing stat access time on Haiku", 2; + } + is_deeply $lstat, $stat; + Time::HiRes::sleep(rand(0.1) + 0.1); + open(X, '<', $$); + <X>; + close(X); + $stat = [Time::HiRes::stat($$)]; + push @atime, $stat->[8]; + $lstat = [Time::HiRes::lstat($$)]; + is_deeply $lstat, $stat; + } } 1 while unlink $$; print("# mtime = @mtime\n"); @@ -69,6 +74,7 @@ print("# ai = $ai, mi = $mi, ss = $ss\n"); # 20% of subsecond results. Yes, this is guessing. SKIP: { skip "no subsecond timestamps detected", 1 if $ss == 0; + skip "testing stat access on Haiku", 1 if $^O eq "haiku"; ok $mi/(@mtime-1) >= 0.75 && $ai/(@atime-1) >= 0.75 && $ss/(@mtime+@atime) >= 0.2; } @@ -89,6 +95,7 @@ SKIP: { is scalar(@tgt_lstat), 13; is scalar(@lnk_stat), 13; is scalar(@lnk_lstat), 13; + skip "testing stat access on Haiku", 3 if $^O eq "haiku"; is_deeply \@tgt_stat, \@tgt_lstat; is_deeply \@tgt_stat, \@lnk_stat; isnt $lnk_lstat[2], $tgt_stat[2]; diff --git a/lib/File/stat.pm b/lib/File/stat.pm index d4993681da..57b8a39eb7 100644 --- a/lib/File/stat.pm +++ b/lib/File/stat.pm @@ -11,7 +11,7 @@ BEGIN { *warnif = \&warnings::warnif } our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); -our $VERSION = '1.10'; +our $VERSION = '1.11'; our @fields; our ( $st_dev, $st_ino, $st_mode, diff --git a/lib/File/stat.t b/lib/File/stat.t index fc9bb12cef..07987a04c2 100644 --- a/lib/File/stat.t +++ b/lib/File/stat.t @@ -84,12 +84,20 @@ sub test_X_ops { } is($@, '', "Overload succeeds $desc"); - if ($^O eq "VMS" && $op =~ /[rwxRWX]/) { - is($vwarn, 1, "warning about VMS ACLs $desc"); - } else { - is($rv, eval "-$op \$file", "correct overload $desc") - unless $access; - is($vwarn, undef, "no warnings about VMS ACLs $desc"); + SKIP : { + if ($^O eq "haiku" && $op =~ /A/) { + # atime is not stored on Haiku BFS + # and stat always returns local time instead + skip "testing -A $desc_tail on Haiku", 1; + } + + if ($^O eq "VMS" && $op =~ /[rwxRWX]/) { + is($vwarn, 1, "warning about VMS ACLs $desc"); + } else { + is($rv, eval "-$op \$file", "correct overload $desc") + unless $access; + is($vwarn, undef, "no warnings about VMS ACLs $desc"); + } } # 111640 - File::stat bogus index check in overload |