Haiku BFS does not store atime and always return current time

Perl · Jul 8, 2021 · c83c098 · c83c098
1 parent 158b05f
commit c83c098
Show file tree

Hide file tree

Showing 4 changed files with 32 additions and 17 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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