cpan/Cwd/t/crossplatform.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use File::Spec;
   5 use lib File::Spec->catfile('t', 'lib');
   6 use Test::More;
   7 local $|=1;
   8
   9 my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32);
  10 my $tests_per_platform = 10;
  11
  12 my $vms_unix_rpt = 0;
  13 my $vms_efs = 0;
  14 my $vms_unix_mode = 0;
  15 my $vms_real_root = 0;
  16
  17 if ($^O eq 'VMS') {
  18     $vms_unix_mode = 0;
  19     if (eval 'require VMS::Feature') {
  20         $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
  21         $vms_efs = VMS::Feature::current("efs_charset");
  22     } else {
  23         my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
  24         my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
  25         $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
  26         $vms_efs = $efs_charset =~ /^[ET1]/i;
  27     }
  28
  29     # Traditional VMS mode only if VMS is not in UNIX compatible mode.
  30     $vms_unix_mode = ($vms_efs && $vms_unix_rpt);
  31
  32     # If we are in UNIX mode, we may or may not have a real root.
  33     if ($vms_unix_mode) {
  34         my $rootdir = File::Spec->rootdir;
  35         $vms_real_root = 1 if ($rootdir eq '/');
  36     }
  37
  38 }
  39
  40
  41 plan tests => 1 + @platforms * $tests_per_platform;
  42
  43 my %volumes = (
  44                Mac => 'Macintosh HD',
  45                OS2 => 'A:',
  46                Win32 => 'A:',
  47                VMS => 'v',
  48               );
  49 my %other_vols = (
  50                   Mac => 'Mounted Volume',
  51                   OS2 => 'B:',
  52                   Win32 => 'B:',
  53                   VMS => 'w',
  54               );
  55
  56 ok 1, "Loaded";
  57
  58 foreach my $platform (@platforms) {
  59   my $module = "File::Spec::$platform";
  60
  61  SKIP:
  62   {
  63     eval "require $module; 1";
  64
  65     skip "Can't load $module", $tests_per_platform
  66       if $@;
  67
  68     my $v = $volumes{$platform} || '';
  69     my $other_v = $other_vols{$platform} || '';
  70
  71     # Fake out the environment on MacOS and Win32
  72     no strict 'refs';
  73     my $save_w = $^W;
  74     $^W = 0;
  75     local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" };
  76     local *{"File::Spec::Win32::_cwd"}  = sub { "C:\\foo" };
  77     $^W = $save_w;
  78     use strict 'refs';
  79
  80
  81     my ($file, $base, $result);
  82
  83     $base = $module->catpath($v, $module->catdir('', 'foo'), '');
  84     $base = $module->catdir($module->rootdir, 'foo');
  85
  86     is $module->file_name_is_absolute($base), 1, "$base is absolute on $platform";
  87
  88     # splitdir('') -> ()
  89     my @result = $module->splitdir('');
  90     is @result, 0, "$platform->splitdir('') -> ()";
  91
  92     # canonpath() -> undef
  93     $result = $module->canonpath();
  94     is $result, undef, "$platform->canonpath() -> undef";
  95
  96     # canonpath(undef) -> undef
  97     $result = $module->canonpath(undef);
  98     is $result, undef, "$platform->canonpath(undef) -> undef";
  99
 100     # abs2rel('A:/foo/bar', 'A:/foo')    ->  'bar'
 101     $file = $module->catpath($v, $module->catdir($module->rootdir, 'foo', 'bar'), 'file');
 102     $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
 103     $result = $module->catfile('bar', 'file');
 104
 105     if ($vms_unix_mode and $platform eq 'VMS') {
 106         # test 56 special
 107         # If VMS is in UNIX mode, so is the result, but having the volume
 108         # parameter present forces the abs2rel into VMS mode.
 109         $result = VMS::Filespec::vmsify($result);
 110         $result =~ s/\.$//;
 111
 112         # If we have a real root, then we are dealing with absolute directories
 113         $result =~ s/\[\./\[/ if $vms_real_root;
 114     }
 115
 116     is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
 117
 118
 119     # abs2rel('A:/foo/bar', 'B:/foo')    ->  'A:/foo/bar'
 120     $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), '');
 121     $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
 122     is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
 123
 124
 125     # abs2rel('A:/foo/bar', '/foo')      ->  'A:/foo/bar'
 126     $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), '');
 127     $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file');
 128     is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
 129
 130
 131     # abs2rel('/foo/bar/file', 'A:/foo')    ->  '/foo/bar'
 132     $file = $module->catpath('', $module->catdir($module->rootdir, 'foo', 'bar'), 'file');
 133     $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
 134     $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file');
 135
 136     if ($vms_unix_mode and $platform eq 'VMS') {
 137         # test 59 special
 138         # If VMS is in UNIX mode, so is the result, but having the volume
 139         # parameter present forces the abs2rel into VMS mode.
 140         $result = VMS::Filespec::vmsify($result);
 141     }
 142
 143     is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
 144
 145
 146     # abs2rel('/foo/bar', 'B:/foo')    ->  '/foo/bar'
 147     $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), '');
 148     $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file');
 149
 150     if ($vms_unix_mode and $platform eq 'VMS') {
 151         # test 60 special
 152         # If VMS is in UNIX mode, so is the result, but having the volume
 153         # parameter present forces the abs2rel into VMS mode.
 154         $result = VMS::Filespec::vmsify($result);
 155     }
 156
 157     is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
 158
 159
 160     # abs2rel('/foo/bar', '/foo')      ->  'bar'
 161     $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), '');
 162     $result = $module->catfile('bar', 'file');
 163
 164     is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)";
 165   }
 166 }
 167
 168 sub volumes_differ {
 169   my ($module, $one, $two) = @_;
 170   my ($one_v) = $module->splitpath( $module->rel2abs($one) );
 171   my ($two_v) = $module->splitpath( $module->rel2abs($two) );
 172   return $one_v ne $two_v;
 173 }