Win32: implement our own stat(), and hence our own utime

This fixes at least two problems:

- unlike UCRT, the MSVCRT used for gcc builds has a bug converting
  a FILETIME in an unlike current DST state, returning a time
  offset by an hour.  Fixes GH #6080

- the MSVCRT apparently uses FindFirstFile() to fetch file
  information, but this doesn't follow symlinks(), so stat()
  ends up returning information about the symlink(), not the
  underlying file.  This isn't an issue with the UCRT which
  opens the file as this implementation does.

Currently this code calculates the time_t for st_*time, and the
other way for utime() using a simple multiplication and offset
between time_t and FILETIME values, but this may be incorrect
if leap seconds are enabled.

This code also requires Vista or later.

Some of this is based on code by Tomasz Konojacki (xenu).

1 files changed, 75 insertions, 16 deletions

diff --git a/t/win32/stat.t b/t/win32/stat.t
index ad5c5b7c88..6046994f61 100644
--- a/t/win32/stat.t
+++ b/t/win32/stat.t
@@ -7,6 +7,7 @@ BEGIN {
 }
 
 use strict;
+use Fcntl ":seek";
 
 Win32::FsType() eq 'NTFS'
     or skip_all("need NTFS");
@@ -21,6 +22,9 @@ ok(link($0, $tmpfile1), "make a link to test nlink");
 my @st = stat $0;
 open my $fh, "<", $0 or die;
 my @fst = stat $fh;
+
+ok(seek($fh, 0, SEEK_END), "seek to end");
+my $size = tell($fh);
 close $fh;
 
 # the ucrt stat() is inconsistent here, using an A=0 drive letter for stat()
@@ -37,6 +41,23 @@ ok($st[1], "and ino");
 # unlikely, but someone else might have linked to win32/stat.t
 cmp_ok($st[3], '>', 1, "should be more than one link");
 
+# we now populate all stat fields ourselves, so check what we can
+is($st[7], $size, "we fetch size correctly");
+
+cmp_ok($st[9], '<=', time(), "modification time before or on now");
+ok(-f $0, "yes, we are a file");
+ok(-d "win32", "and win32 is a directory");
+pipe(my ($p1, $p2));
+ok(-p $p1, "a pipe is a pipe");
+close $p1; close $p2;
+ok(-r $0, "we are readable");
+ok(!-x $0, "but not executable");
+ok(-e $0, "we exist");
+
+ok(open(my $nul, ">", "nul"), "open nul");
+ok(-c $nul, "nul is a character device");
+close $nul;
+
 my $nlink = $st[3];
 
 # check we get nlinks etc for a directory
@@ -45,25 +66,16 @@ ok($st[0], "got dev for a directory");
 ok($st[1], "got ino for a directory");
 ok($st[3], "got nlink for a directory");
 
-${^WIN32_SLOPPY_STAT} = 1;
-
-@st = stat $0;
-open my $fh, "<", $0 or die;
-@fst = stat $fh;
-close $fh;
-
-$st[6] = $fst[6] = 0;
-
-is("@st", "@fst", "sloppy check named stat vs handle stat");
-is($st[0], 0, "sloppy no dev");
-is($st[1], 0, "sloppy no ino");
-# don't check nlink, Microsoft might fix it one day
-
-${^WIN32_SLOPPY_STAT} = 0;
-
 # symbolic links
 unlink($tmpfile1); # no more hard link
 
+if (open my $fh, ">", "$tmpfile1.bat") {
+    ok(-x "$tmpfile1.bat", 'batch file is "executable"');
+    ok(-x $fh, 'batch file handle is "executable"');
+    close $fh;
+    unlink "$tmpfile1.bat";
+}
+
 # mklink is available from Vista onwards
 # this may only work in an admin shell
 # MKLINK [[/D] | [/H] | [/J]] Link Target
@@ -108,4 +120,51 @@ if (system("mklink /j $tmpfile1 win32") == 0) {
     rmdir( $tmpfile1 );
 }
 
+# test interaction between stat and utime
+if (ok(open(my $fh, ">", $tmpfile1), "make a work file")) {
+    # make our test file
+    close $fh;
+
+    my @st = stat $tmpfile1;
+    ok(@st, "stat our work file");
+
+    # switch to the other half of the year, to flip from/to daylight
+    # savings time.  It won't always do so, but it's close enough and
+    # avoids having to deal with working out exactly when it
+    # starts/ends (if it does), along with the hemisphere.
+    #
+    # By basing this on the current file times and using an offset
+    # that's the multiple of an hour we ensure the filesystem
+    # resolution supports the time we set.
+    my $moffset = 6 * 30 * 24 * 3600;
+    my $aoffset = $moffset - 24 * 3600;;
+    my $mymt = $st[9] - $moffset;
+    my $myat = $st[8] - $aoffset;
+    ok(utime($myat, $mymt, $tmpfile1), "set access and mod times");
+    my @mst = stat $tmpfile1;
+    ok(@mst, "fetch stat after utime");
+    is($mst[9], $mymt, "check mod time");
+    is($mst[8], $myat, "check access time");
+
+    unlink $tmpfile1;
+}
+
+# same for a directory
+if (ok(mkdir($tmpfile1), "make a work directory")) {
+    my @st = stat $tmpfile1;
+    ok(@st, "stat our work directory");
+
+    my $moffset = 6 * 30 * 24 * 3600;
+    my $aoffset = $moffset - 24 * 3600;;
+    my $mymt = $st[9] - $moffset;
+    my $myat = $st[8] - $aoffset;
+    ok(utime($myat, $mymt, $tmpfile1), "set access and mod times");
+    my @mst = stat $tmpfile1;
+    ok(@mst, "fetch stat after utime");
+    is($mst[9], $mymt, "check mod time");
+    is($mst[8], $myat, "check access time");
+
+    rmdir $tmpfile1;
+}
+
 done_testing();