Move Cwd from ext/ to cpan/
[perl.git] / 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 }