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); |
10 | my $tests_per_platform = 7; |
11 | |
12 | plan tests => 1 + @platforms * $tests_per_platform; |
13 | |
14 | my %volumes = ( |
15 | Mac => 'Macintosh HD', |
16 | OS2 => 'A:', |
17 | Win32 => 'A:', |
18 | VMS => 'v', |
19 | ); |
20 | my %other_vols = ( |
21 | Mac => 'Mounted Volume', |
22 | OS2 => 'B:', |
23 | Win32 => 'B:', |
24 | VMS => 'w', |
25 | ); |
26 | |
27 | ok 1, "Loaded"; |
28 | |
29 | foreach my $platform (@platforms) { |
30 | my $module = "File::Spec::$platform"; |
31 | |
32 | SKIP: |
33 | { |
34 | eval "require $module; 1"; |
35 | |
36 | skip "Can't load $module", $tests_per_platform |
37 | if $@; |
38 | |
39 | my $v = $volumes{$platform} || ''; |
40 | my $other_v = $other_vols{$platform} || ''; |
41 | |
42 | # Fake out the rootdir on MacOS |
43 | no strict 'refs'; |
44 | my $save_w = $^W; |
45 | $^W = 0; |
46 | local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" }; |
47 | $^W = $save_w; |
48 | use strict 'refs'; |
49 | |
50 | my ($file, $base, $result); |
51 | |
52 | $base = $module->catpath($v, $module->catdir('', 'foo'), ''); |
53 | $base = $module->catdir($module->rootdir, 'foo'); |
54 | |
55 | is $module->file_name_is_absolute($base), 1, "$base is absolute on $platform"; |
56 | |
57 | |
58 | # abs2rel('A:/foo/bar', 'A:/foo') -> 'bar' |
59 | $file = $module->catpath($v, $module->catdir($module->rootdir, 'foo', 'bar'), 'file'); |
60 | $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), ''); |
61 | $result = $module->catfile('bar', 'file'); |
62 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
63 | |
64 | # abs2rel('A:/foo/bar', 'B:/foo') -> 'A:/foo/bar' |
65 | $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), ''); |
66 | $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file'); |
67 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
68 | |
69 | # abs2rel('A:/foo/bar', '/foo') -> 'A:/foo/bar' |
70 | $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), ''); |
71 | $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file'); |
72 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
73 | |
74 | # abs2rel('/foo/bar', 'A:/foo') -> '/foo/bar' |
75 | $file = $module->catpath('', $module->catdir($module->rootdir, 'foo', 'bar'), 'file'); |
76 | $base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), ''); |
77 | $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file'); |
78 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
79 | |
80 | # abs2rel('/foo/bar', 'B:/foo') -> '/foo/bar' |
81 | $base = $module->catpath($other_v, $module->catdir($module->rootdir, 'foo'), ''); |
82 | $result = volumes_differ($module, $file, $base) ? $file : $module->catfile('bar', 'file'); |
83 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
84 | |
85 | # abs2rel('/foo/bar', '/foo') -> 'bar' |
86 | $base = $module->catpath('', $module->catdir($module->rootdir, 'foo'), ''); |
87 | $result = $module->catfile('bar', 'file'); |
88 | is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file, $base)"; |
89 | } |
90 | } |
91 | |
92 | sub volumes_differ { |
93 | my ($module, $one, $two) = @_; |
94 | my ($one_v) = $module->splitpath( $module->rel2abs($one) ); |
95 | my ($two_v) = $module->splitpath( $module->rel2abs($two) ); |
96 | return $one_v ne $two_v; |
97 | } |