diff options
Diffstat (limited to 't/win32/stat.t')
| -rw-r--r-- | t/win32/stat.t | 74 |
1 files changed, 74 insertions, 0 deletions
diff --git a/t/win32/stat.t b/t/win32/stat.t index c2fe60a326..7fa143750f 100644 --- a/t/win32/stat.t +++ b/t/win32/stat.t @@ -9,6 +9,8 @@ BEGIN { use strict; use Fcntl ":seek"; use Config; +use Errno; +use Cwd "getcwd"; Win32::FsType() eq 'NTFS' or skip_all("need NTFS"); @@ -18,6 +20,7 @@ my (undef, $maj, $min) = Win32::GetOSVersion(); my $vista_or_later = $maj >= 6; my $tmpfile1 = tempfile(); +my $tmpfile2 = tempfile(); # test some of the win32 specific stat code, since we # don't depend on the CRT for some of it @@ -249,4 +252,75 @@ if (ok(mkdir($tmpfile1), "make a work directory")) { ok(!-e '"', qq(filename '"' shouldn't exist)); } +# https://github.com/Perl/perl5/issues/20204 +# Win32: stat/unlink fails on UNIX sockets +SKIP: +{ + use IO::Socket; + unlink $tmpfile1; + my $listen = IO::Socket::UNIX->new(Local => $tmpfile1, Listen => 0) + or skip "Cannot create unix socket", 1; + ok(-S $tmpfile1, "can stat a socket"); + ok(!-l $tmpfile1, "doesn't look like a symlink"); + unlink $tmpfile2; + if (system("mklink $tmpfile2 $tmpfile1") == 0) { + ok(-l $tmpfile2, "symlink to socket is a symlink (via lstat)"); + ok(-S $tmpfile2, "symlink to socket is also a socket (via stat)"); + unlink $tmpfile2; + } + close $listen; + unlink $tmpfile1; +} + +{ + # if a symlink chain leads to a socket, or loops, or is broken, + # CreateFileA() fails, so we do our own link following. + # The link leading to a socket is checked above, here check loops + # fail, and that we get ELOOP (which isn't what MSVC returns, but + # try to be better). + if (system("mklink $tmpfile1 $tmpfile2") == 0 + && system("mklink $tmpfile2 $tmpfile1") == 0) { + ok(!stat($tmpfile1), "looping symlink chain fails stat"); + is($!+0, &Errno::ELOOP, "check error set"); + ok(lstat($tmpfile1), "looping symlink chain passes lstat"); + + unlink $tmpfile2; + ok(!stat($tmpfile1), "broken symlink"); + is($!+0, &Errno::ENOENT, "check error set"); + ok(lstat($tmpfile1), "broken symlink chain passes lstat"); + } + unlink $tmpfile1, $tmpfile2; +} + +{ + # $tmpfile4 -> $tmpfile1/file1 -> ../$tmpfile2 -> abspath($tmpfile3) + # $tmpfile3 either doesn't exist, is a file, or is a socket + my ($tmpfile3, $tmpfile4) = (tempfile(), tempfile()); + ok(mkdir($tmpfile1), "make a directory"); + my $cwd = getcwd(); + if (system(qq(mklink $tmpfile4 $tmpfile1\\file1)) == 0 + && system(qq(mklink $tmpfile1\\file1 ..\\$tmpfile2)) == 0 + && system(qq(mklink $tmpfile2 "$cwd\\$tmpfile3")) == 0) { + ok(-l $tmpfile4, "yes, $tmpfile4 is a symlink"); + ok(!-e $tmpfile4, "but we can't stat it"); + + open my $fh, ">", $tmpfile3 or die $!; + close $fh; + ok(-f $tmpfile4, "now $tmpfile4 leads to a file"); + unlink $tmpfile3; + + SKIP: + { + my $listen = IO::Socket::UNIX->new(Local => $tmpfile3, Listen => 0) + or skip "Cannot create unix socket", 1; + ok(!-f $tmpfile4, "$tmpfile4 no longer leads to a file"); + ok(-S $tmpfile4, "now $tmpfile4 leads to a socket"); + ok(-S "$tmpfile1/file1", "$tmpfile1/file1 should lead to a socket"); + ok(-S $tmpfile2, "$tmpfile2 should lead to a socket"); + unlink $tmpfile3; + } + } + unlink $tmpfile2, $tmpfile4, "$tmpfile1/file1"; + rmdir $tmpfile1; +} done_testing(); |