This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Win32: add lstat(), fetch st_dev and st_ino and fetch st_nlink for fstat
[perl5.git] / t / win32 / stat.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require "./test.pl";
7 }
8
9 use strict;
10
11 Win32::FsType() eq 'NTFS'
12     or skip_all("need NTFS");
13
14 my $tmpfile1 = tempfile();
15
16 # test some of the win32 specific stat code, since we
17 # don't depend on the CRT for some of it
18
19 ok(link($0, $tmpfile1), "make a link to test nlink");
20
21 my @st = stat $0;
22 open my $fh, "<", $0 or die;
23 my @fst = stat $fh;
24 close $fh;
25
26 # the ucrt stat() is inconsistent here, using an A=0 drive letter for stat()
27 # and the fd for fstat(), I assume that's something backward compatible.
28 #
29 # I don't see anything we could reasonable populate it with either.
30 $st[6] = $fst[6] = 0;
31
32 is("@st", "@fst", "check named stat vs handle stat");
33
34 ok($st[0], "we set dev by default now");
35 ok($st[1], "and ino");
36
37 # unlikely, but someone else might have linked to win32/stat.t
38 cmp_ok($st[3], '>', 1, "should be more than one link");
39
40 my $nlink = $st[3];
41
42 # check we get nlinks etc for a directory
43 @st = stat("win32");
44 ok($st[0], "got dev for a directory");
45 ok($st[1], "got ino for a directory");
46 ok($st[3], "got nlink for a directory");
47
48 ${^WIN32_SLOPPY_STAT} = 1;
49
50 @st = stat $0;
51 open my $fh, "<", $0 or die;
52 @fst = stat $fh;
53 close $fh;
54
55 $st[6] = $fst[6] = 0;
56
57 is("@st", "@fst", "sloppy check named stat vs handle stat");
58 is($st[0], 0, "sloppy no dev");
59 is($st[1], 0, "sloppy no ino");
60 # don't check nlink, Microsoft might fix it one day
61
62 ${^WIN32_SLOPPY_STAT} = 0;
63
64 # symbolic links
65 unlink($tmpfile1); # no more hard link
66
67 # mklink is available from Vista onwards
68 # this may only work in an admin shell
69 # MKLINK [[/D] | [/H] | [/J]] Link Target
70 if (system("mklink $tmpfile1 win32\\stat.t") == 0) {
71     ok(-l $tmpfile1, "lstat sees a symlink");
72
73     # check stat on file vs symlink
74     @st = stat $0;
75     my @lst = stat $tmpfile1;
76
77     $st[6] = $lst[6] = 0;
78
79     is("@st", "@lst", "check stat on file vs link");
80
81     # our hard link no longer exists, check that is reflected in nlink
82     is($st[3], $nlink-1, "check nlink updated");
83
84     unlink($tmpfile1);
85 }
86
87 # similarly for a directory
88 if (system("mklink /d $tmpfile1 win32") == 0) {
89     ok(-l $tmpfile1, "lstat sees a symlink on the directory symlink");
90
91     # check stat on directory vs symlink
92     @st = stat "win32";
93     my @lst = stat $tmpfile1;
94
95     $st[6] = $lst[6] = 0;
96
97     is("@st", "@lst", "check stat on dir vs link");
98
99     # for now at least, we need to rmdir symlinks to directories
100     rmdir( $tmpfile1 );
101 }
102
103 # check a junction doesn't look like a symlink
104
105 if (system("mklink /j $tmpfile1 win32") == 0) {
106     ok(!-l $tmpfile1, "lstat doesn't see a symlink on the directory junction");
107
108     rmdir( $tmpfile1 );
109 }
110
111 done_testing();