This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH-revised] ext/Win32/t/Unicode.t failures on FAT32 under Cygwin
[perl5.git] / ext / Win32 / t / Unicode.t
1 use strict;
2 use Test;
3 use Cwd qw(cwd);
4 use Win32;
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     }
11     if ((((Win32::FsType())[1] & 4) == 0) || (Win32::FsType() =~ /^FAT/)) {
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();
22 my $cwd  = cwd(); # may be a Cygwin path
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
66 my $subdir = cwd();
67
68 # change back to home directory to make sure relative paths
69 # in @INC continue to work
70 ok(chdir($home));
71 ok(Win32::GetCwd(), $home);
72
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
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);