ext/Win32/t/Unicode.t

   1 use strict;
   2 use Test;
   3 use Win32;
   4
   5 use Cwd qw(cwd);
   6
   7 BEGIN {
   8     if ($^O eq 'cygwin') {
   9         print "1..0 # Skip: Cygwin doesn't support Unicode filenames\n";
  10         exit 0;
  11     }
  12     unless (defined &Win32::BuildNumber && Win32::BuildNumber() >= 820 or $] >= 5.008009) {
  13         print "1..0 # Skip: Needs ActivePerl 820 or Perl 5.8.9 or later\n";
  14         exit 0;
  15     }
  16     unless ((Win32::FsType())[1] & 4) {
  17         print "1..0 # Skip: Filesystem doesn't support Unicode\n";
  18         exit 0;
  19     }
  20     unless ((Win32::GetOSVersion())[1] > 4) {
  21         print "1..0 # Skip: Unicode support requires Windows 2000 or later\n";
  22         exit 0;
  23     }
  24 }
  25
  26 my $home = Win32::GetCwd();
  27 my $dir  = "Foo \x{394}\x{419} Bar \x{5E7}\x{645} Baz";
  28 my $file = "$dir\\xyzzy \x{394}\x{419} plugh \x{5E7}\x{645}";
  29
  30 sub cleanup {
  31     chdir($home);
  32     my $ansi = Win32::GetANSIPathName($file);
  33     unlink($ansi) if -f $ansi;
  34     $ansi = Win32::GetANSIPathName($dir);
  35     rmdir($ansi) if -d $ansi;
  36 }
  37
  38 cleanup();
  39 END { cleanup() }
  40
  41 plan test => 12;
  42
  43 # Create Unicode directory
  44 Win32::CreateDirectory($dir);
  45 ok(-d Win32::GetANSIPathName($dir));
  46
  47 # Create Unicode file
  48 Win32::CreateFile($file);
  49 ok(-f Win32::GetANSIPathName($file));
  50
  51 # readdir() returns ANSI form of Unicode filename
  52 ok(opendir(my $dh, Win32::GetANSIPathName($dir)));
  53 while ($_ = readdir($dh)) {
  54     next if /^\./;
  55     ok($file, Win32::GetLongPathName("$dir\\$_"));
  56 }
  57 closedir($dh);
  58
  59 # Win32::GetLongPathName() of the absolute path restores the Unicode dir name
  60 my $full = Win32::GetFullPathName($dir);
  61 my $long = Win32::GetLongPathName($full);
  62
  63 ok($long, Win32::GetLongPathName($home)."\\$dir");
  64
  65 # We can Win32::SetCwd() into the Unicode directory
  66 ok(Win32::SetCwd($dir));
  67 ok(Win32::GetLongPathName(Win32::GetCwd()), $long);
  68
  69 # cwd() also returns a usable ANSI directory name
  70 (my $cwd = cwd) =~ s,/,\\,g;
  71 ok(Win32::GetLongPathName($cwd), $long);
  72
  73 # change back to home directory
  74 ok(chdir($home));
  75 ok(Win32::GetCwd(), $home);
  76
  77 # We can chdir() into the Unicode directory if we use the ANSI name
  78 ok(chdir(Win32::GetANSIPathName($dir)));
  79 ok(Win32::GetLongPathName(Win32::GetCwd()), $long);