1use strict; 2use Test; 3use Config qw(%Config); 4use Cwd qw(cwd); 5use Encode qw(); 6use Win32; 7 8BEGIN { 9 unless (defined &Win32::BuildNumber && Win32::BuildNumber() >= 820 or $] >= 5.008009) { 10 print "1..0 # Skip: Needs ActivePerl 820 or Perl 5.8.9 or later\n"; 11 exit 0; 12 } 13 if ((((Win32::FsType())[1] & 4) == 0) || (Win32::FsType() =~ /^FAT/)) { 14 print "1..0 # Skip: Filesystem doesn't support Unicode\n"; 15 exit 0; 16 } 17 unless ((Win32::GetOSVersion())[1] > 4) { 18 print "1..0 # Skip: Unicode support requires Windows 2000 or later\n"; 19 exit 0; 20 } 21 Win32::CreateFile("8dot3test_canary_Unicode $$"); 22 my $canary = Win32::GetShortPathName("8dot3test_canary_Unicode $$"); 23 unlink("8dot3test_canary_Unicode $$"); 24 if ( length $canary > 12 ) { 25 print "1..0 # Skip: The system and/or current volume is not configured to support short names.\n"; 26 exit 0; 27 } 28} 29 30my $home = Win32::GetCwd(); 31my $cwd = cwd(); # may be a Cygwin path 32my $dir = "Foo \x{394}\x{419} Bar \x{5E7}\x{645} Baz"; 33my $file = "$dir\\xyzzy \x{394}\x{419} plugh \x{5E7}\x{645}"; 34 35sub cleanup { 36 chdir($home); 37 my $ansi = Win32::GetANSIPathName($file); 38 unlink($ansi) if -f $ansi; 39 $ansi = Win32::GetANSIPathName($dir); 40 rmdir($ansi) if -d $ansi; 41} 42 43cleanup(); 44END { cleanup() } 45 46plan test => 12; 47 48# Create Unicode directory 49Win32::CreateDirectory($dir); 50ok(-d Win32::GetANSIPathName($dir)); 51 52# Create Unicode file 53Win32::CreateFile($file); 54ok(-f Win32::GetANSIPathName($file)); 55 56# readdir() returns ANSI form of Unicode filename 57ok(opendir(my $dh, Win32::GetANSIPathName($dir))); 58while ($_ = readdir($dh)) { 59 next if /^\./; 60 # On Cygwin 1.7 readdir() returns the utf8 representation of the 61 # filename but doesn't turn on the SvUTF8 bit 62 Encode::_utf8_on($_) if $^O eq "cygwin" && $Config{osvers} !~ /^1.5/; 63 ok($file, Win32::GetLongPathName("$dir\\$_")); 64} 65closedir($dh); 66 67# Win32::GetLongPathName() of the absolute path restores the Unicode dir name 68my $full = Win32::GetFullPathName($dir); 69my $long = Win32::GetLongPathName($full); 70 71ok($long, Win32::GetLongPathName($home)."\\$dir"); 72 73# We can Win32::SetCwd() into the Unicode directory 74ok(Win32::SetCwd($dir)); 75 76my $w32dir = Win32::GetCwd(); 77# cwd() also returns a usable ANSI directory name 78my $subdir = cwd(); 79 80# change back to home directory to make sure relative paths 81# in @INC continue to work 82ok(chdir($home)); 83ok(Win32::GetCwd(), $home); 84 85ok(Win32::GetLongPathName($w32dir), $long); 86 87# cwd() on Cygwin returns a mapped path that we need to translate 88# back to a Windows path. Invoking `cygpath` on $subdir doesn't work. 89if ($^O eq "cygwin") { 90 $subdir = Cygwin::posix_to_win_path($subdir, 1); 91} 92$subdir =~ s,/,\\,g; 93# Cygwin64 no longer returns an ANSI name 94skip($^O eq "cygwin", Win32::GetLongPathName($subdir), $long); 95 96# We can chdir() into the Unicode directory if we use the ANSI name 97ok(chdir(Win32::GetANSIPathName($dir))); 98ok(Win32::GetLongPathName(Win32::GetCwd()), $long); 99