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
|
#!/usr/bin/perl -w
use strict;
use Test::More;
use File::Spec;
local $|=1;
my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32);
my $tests_per_platform = 7;
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 rootdir on MacOS
no strict 'refs';
my $save_w = $^W;
$^W = 0;
local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" };
$^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";
# 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');
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', '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) ? $file : $module->catfile('bar', 'file');
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) ? $file : $module->catfile('bar', 'file');
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;
}
|
