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