Commit | Line | Data |
638113eb |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
638113eb |
4 | use File::Spec; |
99f36a73 |
5 | use lib File::Spec->catfile('t', 'lib'); |
6 | use Test::More; |
638113eb |
7 | local $|=1; |
8 | |
9 | my @platforms = qw(Cygwin Epoc Mac OS2 Unix VMS Win32); |
bf7c0a3d |
10 | my $tests_per_platform = 10; |
638113eb |
11 | |
ae5a807c |
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 | |
638113eb |
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 | |
81a4c762 |
71 | # Fake out the environment on MacOS and Win32 |
638113eb |
72 | no strict 'refs'; |
73 | my $save_w = $^W; |
74 | $^W = 0; |
75 | local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" }; |
81a4c762 |
76 | local *{"File::Spec::Win32::_cwd"} = sub { "C:\\foo" }; |
638113eb |
77 | $^W = $save_w; |
78 | use strict 'refs'; |
81a4c762 |
79 | |
80 | |
638113eb |
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 | |
bf7c0a3d |
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"; |
638113eb |
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'); |
ae5a807c |
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 | |
638113eb |
116 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
117 | |
ae5a807c |
118 | |
638113eb |
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 | |
ae5a807c |
124 | |
638113eb |
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 | |
ae5a807c |
130 | |
81a4c762 |
131 | # abs2rel('/foo/bar/file', 'A:/foo') -> '/foo/bar' |
638113eb |
132 | $file = $module->catpath('', $module->catdir($module->rootdir, 'foo', 'bar'), 'file'); |
133 | $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), ''); |
81a4c762 |
134 | $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file'); |
ae5a807c |
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 | |
638113eb |
143 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
144 | |
ae5a807c |
145 | |
638113eb |
146 | # abs2rel('/foo/bar', 'B:/foo') -> '/foo/bar' |
147 | $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), ''); |
81a4c762 |
148 | $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file) : $module->catfile('bar', 'file'); |
ae5a807c |
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 | |
638113eb |
157 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
158 | |
ae5a807c |
159 | |
638113eb |
160 | # abs2rel('/foo/bar', '/foo') -> 'bar' |
161 | $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), ''); |
162 | $result = $module->catfile('bar', 'file'); |
ae5a807c |
163 | |
638113eb |
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 | } |