This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix ext/Win32/t/Unicode.t test failure under Cygwin
[perl5.git] / ext / Win32 / t / Unicode.t
CommitLineData
34f7f30d
SH
1use strict;
2use Test;
34f7f30d 3use Cwd qw(cwd);
d3ca1033 4use Win32;
34f7f30d
SH
5
6BEGIN {
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
21my $home = Win32::GetCwd();
d3ca1033 22my $cwd = cwd(); # may be a Cygwin path
34f7f30d
SH
23my $dir = "Foo \x{394}\x{419} Bar \x{5E7}\x{645} Baz";
24my $file = "$dir\\xyzzy \x{394}\x{419} plugh \x{5E7}\x{645}";
25
26sub 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
34cleanup();
35END { cleanup() }
36
37plan test => 12;
38
39# Create Unicode directory
40Win32::CreateDirectory($dir);
41ok(-d Win32::GetANSIPathName($dir));
42
43# Create Unicode file
44Win32::CreateFile($file);
45ok(-f Win32::GetANSIPathName($file));
46
47# readdir() returns ANSI form of Unicode filename
48ok(opendir(my $dh, Win32::GetANSIPathName($dir)));
49while ($_ = readdir($dh)) {
50 next if /^\./;
51 ok($file, Win32::GetLongPathName("$dir\\$_"));
52}
53closedir($dh);
54
55# Win32::GetLongPathName() of the absolute path restores the Unicode dir name
56my $full = Win32::GetFullPathName($dir);
57my $long = Win32::GetLongPathName($full);
58
59ok($long, Win32::GetLongPathName($home)."\\$dir");
60
61# We can Win32::SetCwd() into the Unicode directory
62ok(Win32::SetCwd($dir));
34f7f30d 63
38bfad48 64my $w32dir = Win32::GetCwd();
34f7f30d 65# cwd() also returns a usable ANSI directory name
d3ca1033 66my $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
70ok(chdir($home));
71ok(Win32::GetCwd(), $home);
72
38bfad48
JH
73ok(Win32::GetLongPathName($w32dir), $long);
74
d3ca1033
JD
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.
77if ($^O eq "cygwin") {
9cdd923e 78 $subdir = Cygwin::posix_to_win_path($subdir, 1);
d3ca1033
JD
79}
80$subdir =~ s,/,\\,g;
81ok(Win32::GetLongPathName($subdir), $long);
82
34f7f30d
SH
83# We can chdir() into the Unicode directory if we use the ANSI name
84ok(chdir(Win32::GetANSIPathName($dir)));
85ok(Win32::GetLongPathName(Win32::GetCwd()), $long);