From: Jarkko Hietaniemi Date: Tue, 16 Sep 2003 05:04:09 +0000 (+0000) Subject: Upgrade to File::Spec 0.85_03. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=638113ebabda13ba02225353c0381661c68f7168;p=p5sagit%2Fp5-mst-13.2.git Upgrade to File::Spec 0.85_03. p4raw-id: //depot/perl@21239 --- diff --git a/MANIFEST b/MANIFEST index d55c6c8..36737c6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1204,6 +1204,7 @@ lib/File/Spec/Functions.pm Function interface to File::Spec object methods lib/File/Spec/Mac.pm portable operations on Mac file names lib/File/Spec/OS2.pm portable operations on OS2 file names lib/File/Spec.pm portable operations on file names +lib/File/Spec/t/crossplatform.t See if File::Spec works crossplatform lib/File/Spec/t/Functions.t See if File::Spec::Functions works lib/File/Spec/t/rel2abs2rel.t See if File::Spec->rel2abs/abs2rel works lib/File/Spec/t/Spec.t See if File::Spec works diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index 3efda13..a911fa2 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -3,7 +3,7 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '0.86'; +$VERSION = '0.85_03'; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', @@ -164,7 +164,8 @@ Mac OS (Classic). It does consult the working environment for VMS =item path -Takes no argument, returns the environment variable PATH as an array. +Takes no argument, returns the environment variable PATH (or the local +platform's equivalent) as a list. @PATH = File::Spec->path(); @@ -225,10 +226,11 @@ relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. -On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. If this -assumption may be wrong (like in VMS), trying to "unify" the paths -abs2rel() results in nonsense. +On systems with the concept of volume, if $path and $base appear to be +on two different volumes, we will not attempt to resolve the two +paths, and we will instead simply return $path. Note that previous +versions of this module ignored the volume of $base, which resulted in +garbage results part of the time. On systems that have a grammar that indicates filenames, this ignores the $base filename as well. Otherwise all path components are assumed to be @@ -254,8 +256,11 @@ If $base is not present or '', then L is used. If $base is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. -On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $path volume. +On systems with the concept of volume, if $path and $base appear to be +on two different volumes, we will not attempt to resolve the two +paths, and we will instead simply return $path. Note that previous +versions of this module ignored the volume of $base, which resulted in +garbage results part of the time. On systems that have a grammar that indicates filenames, this ignores the $base filename as well. Otherwise all path components are assumed to be diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm index 1de06b8..34a7a01 100644 --- a/lib/File/Spec/Mac.pm +++ b/lib/File/Spec/Mac.pm @@ -585,10 +585,16 @@ sub catpath { return $file ; } + # We look for a volume in $volume, then in $directory, but not both + + my ($dir_volume, $dir_dirs) = $self->splitpath($directory, 1); + + $volume = $dir_volume unless length $volume; my $path = $volume; # may be '' $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' if ($directory) { + $directory = $dir_dirs if $volume; $directory =~ s/^://; # remove leading ':' if any $path .= $directory; $path .= ':' unless (substr($path, -1) eq ':'); # ensure trailing ':' @@ -617,11 +623,13 @@ If $base is not present or '', then the current working directory is used. If $base is relative, then it is converted to absolute form using C. This means that it is taken to be relative to the current working directory. -Since Mac OS has the concept of volumes, this assumes that both paths -are on the $destination volume, and ignores the $base volume (!). +If $path and $base appear to be on two different volumes, we will not +attempt to resolve the two paths, and we will instead simply return +$path. Note that previous versions of this module ignored the volume +of $base, which resulted in garbage results part of the time. If $base doesn't have a trailing colon, the last element of $base is -assumed to be a filename. This filename is ignored (!). Otherwise all path +assumed to be a filename. This filename is ignored. Otherwise all path components are assumed to be directories. If $path is relative, it is converted to absolute form using C. @@ -666,11 +674,11 @@ sub abs2rel { $base = _resolve_updirs( $base ); } - # Split up paths - my ( $path_dirs, $path_file ) = ($self->splitpath( $path ))[1,2] ; + # Split up paths - ignore $base's file + my ( $path_vol, $path_dirs, $path_file ) = $self->splitpath( $path ); + my ( $base_vol, $base_dirs ) = $self->splitpath( $base ); - # ignore $base's volume and file - my $base_dirs = ($self->splitpath( $base ))[1] ; + return $path unless lc( $path_vol ) eq lc( $base_vol ); # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_dirs ); @@ -709,7 +717,7 @@ using C. This means that it is taken to be relative to the current working directory. If $base doesn't have a trailing colon, the last element of $base is -assumed to be a filename. This filename is ignored (!). Otherwise all path +assumed to be a filename. This filename is ignored. Otherwise all path components are assumed to be directories. If $path is already absolute, it is returned and $base is ignored. @@ -736,7 +744,7 @@ sub rel2abs { my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ; # ignore $base's file part - my ( $base_vol, $base_dirs, undef ) = $self->splitpath($base) ; + my ( $base_vol, $base_dirs ) = $self->splitpath($base) ; # Glom them together $path_dirs = ':' if ($path_dirs eq ''); diff --git a/lib/File/Spec/OS2.pm b/lib/File/Spec/OS2.pm index f03df72..47dc0a6 100644 --- a/lib/File/Spec/OS2.pm +++ b/lib/File/Spec/OS2.pm @@ -43,6 +43,17 @@ sub tmpdir { '/' ); } +sub catdir { + my $self = shift; + my @args = @_; + foreach (@args) { + tr[\\][/]; + # append a backslash to each argument unless it has one there + $_ .= "/" unless m{/$}; + } + return $self->canonpath(join('', @args)); +} + sub canonpath { my ($self,$path) = @_; $path =~ s/^([a-z]:)/\l$1/s; @@ -52,6 +63,8 @@ sub canonpath { $path =~ s|^(\./)+(?=[^/])||s; # ./xx -> xx $path =~ s|/\Z(?!\n)|| unless $path =~ m#^([a-z]:)?/\Z(?!\n)#si;# xx/ -> xx + $path =~ s{^/\.\.$}{/}; # /.. -> / + 1 while $path =~ s{^/\.\.}{}; # /../xx -> /xx return $path; } @@ -140,10 +153,9 @@ sub abs2rel { } # Split up paths - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path, 1 ) ; - - my $base_directories = ($self->splitpath( $base, 1 ))[1] ; + my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ; + my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; + return $path unless $path_volume eq $base_volume; # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 1309f9d..349757b 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -69,12 +69,8 @@ trailing slash :-) sub catdir { my $self = shift; - my @args = @_; - foreach (@args) { - # append a slash to each argument unless it has one there - $_ .= "/" if $_ eq '' || substr($_,-1) ne "/"; - } - return $self->canonpath(join('', @args)); + + $self->canonpath(join('/', @_, '')); # '' because need a trailing '/' } =item catfile @@ -99,9 +95,7 @@ Returns a string representation of the current directory. "." on UNIX. =cut -sub curdir { - return "."; -} +sub curdir () { '.' } =item devnull @@ -109,9 +103,7 @@ Returns a string representation of the null device. "/dev/null" on UNIX. =cut -sub devnull { - return "/dev/null"; -} +sub devnull () { '/dev/null' } =item rootdir @@ -119,9 +111,7 @@ Returns a string representation of the root directory. "/" on UNIX. =cut -sub rootdir { - return "/"; -} +sub rootdir () { '/' } =item tmpdir @@ -171,9 +161,7 @@ Returns a string representation of the parent directory. ".." on UNIX. =cut -sub updir { - return ".."; -} +sub updir () { '..' } =item no_upwards @@ -194,9 +182,7 @@ is not or is significant when comparing file specifications. =cut -sub case_tolerant { - return 0; -} +sub case_tolerant () { 0 } =item file_name_is_absolute @@ -343,13 +329,8 @@ relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. -On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. If this -assumption may be wrong (like in VMS), trying to "unify" the paths with -abs2rel() results in nonsense. - On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be +$base filename. Otherwise all path components are assumed to be directories. If $path is relative, it is converted to absolute form using L. @@ -425,11 +406,8 @@ relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. -On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $path volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be +On systems that have a grammar that indicates filenames, this ignores +the $base filename. Otherwise all path components are assumed to be directories. If $path is absolute, it is cleaned up and returned using L. diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index d77601e..362cdaa 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -367,6 +367,12 @@ Construct a complete filespec using VMS syntax sub catpath { my($self,$dev,$dir,$file) = @_; + + # We look for a volume in $dev, then in $dir, but not both + my ($dir_volume, $dir_dir, $dir_file) = $self->splitpath($dir); + $dev = $dir_volume unless length $dev; + $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir; + if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; } else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; } if (length($dev) or length($dir)) { @@ -384,33 +390,13 @@ Use VMS syntax when converting filespecs. sub abs2rel { my $self = shift; - return vmspath(File::Spec::Unix::abs2rel( $self, @_ )) - if ( join( '', @_ ) =~ m{/} ) ; + if grep m{/}, @_; my($path,$base) = @_; + $base = $self->_cwd() unless defined $base and length $base; - # Note: we use '/' to glue things together here, then let canonpath() - # clean them up at the end. - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - else { - $path = $self->canonpath( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = $self->canonpath( $self->_cwd ) ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } + for ($path, $base) { $_ = $self->canonpath($_) } # Are we even starting $path on the same (node::)device as $base? Note that # logical paths or nodename differences may be on the "same device" @@ -421,23 +407,12 @@ sub abs2rel { # if there is a case blind device (or node) difference of any sort # and we do not even try to call $parse() or consult %ENV for $trnlnm() # (this module needs to run on non VMS platforms after all). - my $path_device = ($self->splitpath( $path, 1 ))[0]; - my $base_device = ($self->splitpath( $base, 1 ))[0]; - if ( lc( $path_device ) ne lc( $base_device ) ) { - return ( $path ) ; - } + + my ($path_volume, $path_directories, $path_file) = $self->splitpath($path); + my ($base_volume, $base_directories, $base_file) = $self->splitpath($base); + return $path unless lc($path_volume) eq lc($base_volume); - # Split up paths - my ( $path_directories, $path_file ) = - ($self->splitpath( $path, 1 ))[1,2] ; - - $path_directories = $1 - if $path_directories =~ /^\[(.*)\]\Z(?!\n)/s ; - - my $base_directories = ($self->splitpath( $base, 1 ))[1] ; - - $base_directories = $1 - if $base_directories =~ /^\[(.*)\]\Z(?!\n)/s ; + for ($path, $base) { $_ = $self->rel2abs($_) } # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); @@ -455,8 +430,7 @@ sub abs2rel { # @basechunks now contains the directories to climb out of, # @pathchunks now has the directories to descend in to. - $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ; - $path_directories =~ s{\.\Z(?!\n)}{} ; + $path_directories = join '.', ('-' x @basechunks, @pathchunks) ; return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ; } @@ -517,6 +491,9 @@ sub rel2abs { See L and L. This package overrides the implementation of these methods, not the semantics. +An explanation of VMS file specs can be found at +L<"http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_014.html#apps_locating_naming_files">. + =cut 1; diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index a5db2cc..1a91b95 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -92,6 +92,17 @@ sub catfile { return $dir.$file; } +sub catdir { + my $self = shift; + my @args = @_; + foreach (@args) { + tr[/][\\]; + # append a backslash to each argument unless it has one there + $_ .= "\\" unless m{\\$}; + } + return $self->canonpath(join('', @args)); +} + sub path { my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; my @path = split(';',$path); @@ -126,9 +137,7 @@ sub canonpath { return $path if $path =~ m|^\.\.|; # skip relative paths return $path unless $path =~ /\.\./; # too few .'s to cleanup return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup - return $path if $orig_path =~ m|^\Q/../\E| - and $orig_path =~ m|\/$|; # don't do /../dirs/ when called - # from rel2abs() for ../dirs/ + $path =~ s{^\\\.\.$}{\\}; # \.. -> \ 1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx my ($vol,$dirs,$file) = $self->splitpath($path); @@ -289,19 +298,19 @@ sub abs2rel { my($self,$path,$base) = @_; $base = $self->_cwd() unless defined $base and length $base; - for ($path, $base) { - $_ = $self->canonpath($self->rel2abs($_)); - } - my ($path_volume, $path_directories) = $self->splitpath($path, 1) ; - my ($base_volume, $base_directories) = $self->splitpath($base, 1); + for ($path, $base) { $_ = $self->canonpath($_) } - if ($path_volume and not $base_volume) { - ($base_volume) = $self->splitpath($self->_cwd); - } + my ($path_volume) = $self->splitpath($path, 1); + my ($base_volume) = $self->splitpath($base, 1); # Can't relativize across volumes return $path unless $path_volume eq $base_volume; + for ($path, $base) { $_ = $self->rel2abs($_) } + + my $path_directories = ($self->splitpath($path, 1))[1]; + my $base_directories = ($self->splitpath($base, 1))[1]; + # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); my @basechunks = $self->splitdir( $base_directories ); diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t index bcd0990..182daf1 100644 --- a/lib/File/Spec/t/Spec.t +++ b/lib/File/Spec/t/Spec.t @@ -171,6 +171,10 @@ if ($^O eq 'MacOS') { [ "Win32->catdir()", '' ], [ "Win32->catdir('')", '\\' ], [ "Win32->catdir('/')", '\\' ], +[ "Win32->catdir('/', '../')", '\\' ], +[ "Win32->catdir('/', '..\\')", '\\' ], +[ "Win32->catdir('\\', '../')", '\\' ], +[ "Win32->catdir('\\', '..\\')", '\\' ], [ "Win32->catdir('//d1','d2')", '\\\\d1\\d2' ], [ "Win32->catdir('\\d1\\','d2')", '\\d1\\d2' ], [ "Win32->catdir('\\d1','d2')", '\\d1\\d2' ], @@ -190,6 +194,7 @@ if ($^O eq 'MacOS') { #[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3' ], [ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ], [ "Win32->catdir('A:/')", 'A:\\' ], +[ "Win32->catdir('\\', 'foo')", '\\foo' ], [ "Win32->catfile('a','b','c')", 'a\\b\\c' ], [ "Win32->catfile('a','b','.\\c')", 'a\\b\\c' ], @@ -201,6 +206,7 @@ if ($^O eq 'MacOS') { [ "Win32->canonpath('')", '' ], [ "Win32->canonpath('a:')", 'A:' ], [ "Win32->canonpath('A:f')", 'A:f' ], +[ "Win32->canonpath('A:/')", 'A:\\' ], [ "Win32->canonpath('//a\\b//c')", '\\\\a\\b\\c' ], [ "Win32->canonpath('/a/..../c')", '\\a\\....\\c' ], [ "Win32->canonpath('//a/b\\c')", '\\\\a\\b\\c' ], @@ -214,6 +220,10 @@ if ($^O eq 'MacOS') { [ "Win32->canonpath('/a/b/c/../../d')", '\\a\\d' ], [ "Win32->canonpath('/a/b/c/.../d')", '\\a\\d' ], [ "Win32->canonpath('\\../temp\\')", '\\temp' ], +[ "Win32->canonpath('\\../')", '\\' ], +[ "Win32->canonpath('\\..\\')", '\\' ], +[ "Win32->canonpath('/../')", '\\' ], +[ "Win32->canonpath('/..\\')", '\\' ], [ "Win32->can('_cwd')", qr/CODE/ ], # FakeWin32 subclass (see below) just sets CWD to C:\one\two @@ -275,6 +285,7 @@ if ($^O eq 'MacOS') { [ "VMS->catpath('','[.d1.d2.d3]','file')", '[.d1.d2.d3]file' ], [ "VMS->catpath('','d1/d2/d3','file')", '[.d1.d2.d3]file' ], [ "VMS->catpath('v','d1/d2/d3','file')", 'v:[.d1.d2.d3]file' ], +[ "VMS->catpath('v','w:[d1.d2.d3]','file')", 'v:[d1.d2.d3]file' ], [ "VMS->catpath('node::volume:','[d1.d2.d3]','')", 'node::volume:[d1.d2.d3]' ], [ "VMS->catpath('node::volume:','[d1.d2.d3]','file')", 'node::volume:[d1.d2.d3]file' ], [ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')", 'node"access_spec"::volume:[d1.d2.d3]' ], @@ -310,9 +321,11 @@ if ($^O eq 'MacOS') { [ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", 'node::volume:[t1.t2.t4]' ], [ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", '' ], [ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')", 'file' ], +[ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2]')", '[.t3]file' ], +[ "VMS->abs2rel('v:[t1.t2.t3]file','v:[t1.t2]')", '[.t3]file' ], [ "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], [ "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')", '[-]file' ], -[ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", '[t4]' ], +[ "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')", '[.t4]' ], [ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", '[---.t4.t5.t6]' ], [ "VMS->abs2rel('[000000]','[t1.t2.t3]')", '[---]' ], [ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')", '[-.t4]' ], @@ -336,6 +349,11 @@ if ($^O eq 'MacOS') { [ "OS2->catfile('c')", 'c' ], [ "OS2->catfile('./c')", 'c' ], +[ "OS2->catdir('/', '../')", '/' ], +[ "OS2->catdir('/', '..\\')", '/' ], +[ "OS2->catdir('\\', '../')", '/' ], +[ "OS2->catdir('\\', '..\\')", '/' ], + [ "Mac->case_tolerant()", '1' ], [ "Mac->catpath('','','')", '' ], @@ -359,6 +377,7 @@ if ($^O eq 'MacOS') { [ "Mac->catpath('hd:','d1','file')", 'hd:d1:file' ], [ "Mac->catpath('hd:',':d1:',':file')", 'hd:d1:file' ], +[ "Mac->catpath('hd:','hd:d1','')", 'hd:d1:' ], [ "Mac->catpath('','d1','')", ':d1:' ], [ "Mac->catpath('',':d1','')", ':d1:' ], @@ -509,7 +528,7 @@ if ($^O eq 'MacOS') { [ "Mac->abs2rel('hd:d3:','hd:d1:d2:')", ':::d3:' ], # same as above [ "Mac->abs2rel('hd:d1:d2:d3:','hd:d1:d2:')", ':d3:' ], [ "Mac->abs2rel('hd:d1:d2:d3::','hd:d1:d2:')", ':d3::' ], -[ "Mac->abs2rel('hd1:d3:d4:d5:','hd2:d1:d2:')", ':::d3:d4:d5:' ], # ignore base's volume +[ "Mac->abs2rel('hd1:d3:d4:d5:','hd2:d1:d2:')", 'hd1:d3:d4:d5:'], # volume mismatch [ "Mac->abs2rel('hd:','hd:d1:d2:')", ':::' ], [ "Mac->rel2abs(':d3:','hd:d1:d2:')", 'hd:d1:d2:d3:' ], diff --git a/lib/File/Spec/t/crossplatform.t b/lib/File/Spec/t/crossplatform.t new file mode 100644 index 0000000..a98e091 --- /dev/null +++ b/lib/File/Spec/t/crossplatform.t @@ -0,0 +1,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; +}