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
  64 my $w32dir = Win32::GetCwd();
  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 ok(Win32::GetLongPathName($w32dir), $long);
  74
  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") {
  78     $subdir = Cygwin::posix_to_win_path($subdir, 1);
  79 }
  80 $subdir =~ s,/,\\,g;
  81 ok(Win32::GetLongPathName($subdir), $long);
  82
  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);