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