Commit | Line | Data |
34f7f30d |
1 | use strict; |
2 | use Test; |
34f7f30d |
3 | use Cwd qw(cwd); |
d3ca1033 |
4 | use Win32; |
34f7f30d |
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 |
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 |
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)); |
34f7f30d |
63 | |
38bfad48 |
64 | my $w32dir = Win32::GetCwd(); |
34f7f30d |
65 | # cwd() also returns a usable ANSI directory name |
d3ca1033 |
66 | my $subdir = cwd(); |
34f7f30d |
67 | |
d3ca1033 |
68 | # change back to home directory to make sure relative paths |
69 | # in @INC continue to work |
34f7f30d |
70 | ok(chdir($home)); |
71 | ok(Win32::GetCwd(), $home); |
72 | |
38bfad48 |
73 | ok(Win32::GetLongPathName($w32dir), $long); |
74 | |
d3ca1033 |
75 | # cwd() on Cygwin returns a mapped path that we need to translate |
76 | # back to a Windows path. Invoking `cygpath` on $subdir doesn't work. |
77 | if ($^O eq "cygwin") { |
9cdd923e |
78 | $subdir = Cygwin::posix_to_win_path($subdir, 1); |
d3ca1033 |
79 | } |
80 | $subdir =~ s,/,\\,g; |
81 | ok(Win32::GetLongPathName($subdir), $long); |
82 | |
34f7f30d |
83 | # We can chdir() into the Unicode directory if we use the ANSI name |
84 | ok(chdir(Win32::GetANSIPathName($dir))); |
85 | ok(Win32::GetLongPathName(Win32::GetCwd()), $long); |