Commit | Line | Data |
---|---|---|
34f7f30d SH |
1 | use strict; |
2 | use Test; | |
34f7f30d | 3 | use Cwd qw(cwd); |
d3ca1033 | 4 | use Win32; |
34f7f30d SH |
5 | |
6 | BEGIN { | |
7 | unless (defined &Win32::BuildNumber && Win32::BuildNumber() >= 820 or $] >= 5.008009) { | |
8 | print "1..0 # Skip: Needs ActivePerl 820 or Perl 5.8.9 or later\n"; | |
9 | exit 0; | |
10 | } | |
52cc7107 | 11 | if ((((Win32::FsType())[1] & 4) == 0) || (Win32::FsType() =~ /^FAT/)) { |
34f7f30d SH |
12 | print "1..0 # Skip: Filesystem doesn't support Unicode\n"; |
13 | exit 0; | |
14 | } | |
15 | unless ((Win32::GetOSVersion())[1] > 4) { | |
16 | print "1..0 # Skip: Unicode support requires Windows 2000 or later\n"; | |
17 | exit 0; | |
18 | } | |
19 | } | |
20 | ||
21 | my $home = Win32::GetCwd(); | |
d3ca1033 | 22 | my $cwd = cwd(); # may be a Cygwin path |
34f7f30d SH |
23 | my $dir = "Foo \x{394}\x{419} Bar \x{5E7}\x{645} Baz"; |
24 | my $file = "$dir\\xyzzy \x{394}\x{419} plugh \x{5E7}\x{645}"; | |
25 | ||
26 | sub cleanup { | |
27 | chdir($home); | |
28 | my $ansi = Win32::GetANSIPathName($file); | |
29 | unlink($ansi) if -f $ansi; | |
30 | $ansi = Win32::GetANSIPathName($dir); | |
31 | rmdir($ansi) if -d $ansi; | |
32 | } | |
33 | ||
34 | cleanup(); | |
35 | END { cleanup() } | |
36 | ||
37 | plan test => 12; | |
38 | ||
39 | # Create Unicode directory | |
40 | Win32::CreateDirectory($dir); | |
41 | ok(-d Win32::GetANSIPathName($dir)); | |
42 | ||
43 | # Create Unicode file | |
44 | Win32::CreateFile($file); | |
45 | ok(-f Win32::GetANSIPathName($file)); | |
46 | ||
47 | # readdir() returns ANSI form of Unicode filename | |
48 | ok(opendir(my $dh, Win32::GetANSIPathName($dir))); | |
49 | while ($_ = readdir($dh)) { | |
50 | next if /^\./; | |
51 | ok($file, Win32::GetLongPathName("$dir\\$_")); | |
52 | } | |
53 | closedir($dh); | |
54 | ||
55 | # Win32::GetLongPathName() of the absolute path restores the Unicode dir name | |
56 | my $full = Win32::GetFullPathName($dir); | |
57 | my $long = Win32::GetLongPathName($full); | |
58 | ||
59 | ok($long, Win32::GetLongPathName($home)."\\$dir"); | |
60 | ||
61 | # We can Win32::SetCwd() into the Unicode directory | |
62 | ok(Win32::SetCwd($dir)); | |
63 | ok(Win32::GetLongPathName(Win32::GetCwd()), $long); | |
64 | ||
65 | # cwd() also returns a usable ANSI directory name | |
d3ca1033 | 66 | my $subdir = cwd(); |
34f7f30d | 67 | |
d3ca1033 JD |
68 | # change back to home directory to make sure relative paths |
69 | # in @INC continue to work | |
34f7f30d SH |
70 | ok(chdir($home)); |
71 | ok(Win32::GetCwd(), $home); | |
72 | ||
d3ca1033 JD |
73 | # cwd() on Cygwin returns a mapped path that we need to translate |
74 | # back to a Windows path. Invoking `cygpath` on $subdir doesn't work. | |
75 | if ($^O eq "cygwin") { | |
76 | chomp(my $cygpath = `cygpath -w "$cwd"`); | |
77 | $subdir =~ s,\Q$cwd\E,$cygpath,; | |
78 | } | |
79 | $subdir =~ s,/,\\,g; | |
80 | ok(Win32::GetLongPathName($subdir), $long); | |
81 | ||
34f7f30d SH |
82 | # We can chdir() into the Unicode directory if we use the ANSI name |
83 | ok(chdir(Win32::GetANSIPathName($dir))); | |
84 | ok(Win32::GetLongPathName(Win32::GetCwd()), $long); |