Bug #3257 for File-chdir: [perl5.8.0/win32] FAILED TESTS

This is an attempt at a more comprehensive patch: * Fixed problems with always prepending rootdir. Prepends q{} for non-Win32 platforms (which is what File::Spec->splitdir() returns in the first place and File::chdir discards). * Changed $CWD to return native path separators. This ensures round trip comparisons where $CWD is set to a File::Spec generated path and then later compared to that path * Fixed comparisons in *.t files to always use native path separators as well. * Bumped Cwd/File::Spec prereqs to cover fixes for Cygwin, the Cwd prototype bug and canonpath fixes. * Updated Changes & Pod.

=== Changes ================================================================== --- Changes (revision 1125) +++ Changes (local) @@ -1,3 +1,11 @@ +0.06_01 + * Fixed bug that prepended "/" to $CWD for Win32 + * $CWD changed to use native path separators + * Tests fixed on Win32 by always using native separators as well + * Upped File::Spec and Cwd dependencies to require many recent bug-fixes + - Added note about comparing $CWD to File::Spec generated names + - Patch submitted by David Golden + 0.06 Thu Aug 14 17:02:32 PDT 2003 * Now working under taint mode (thanks Mark Guckeyson) - Small nit in the SYNOPSIS === Makefile.PL ================================================================== --- Makefile.PL (revision 1125) +++ Makefile.PL (local) @@ -37,8 +37,8 @@ WriteMakefile( NAME => $PACKAGE, VERSION_FROM => "lib/$PACKAGE_FILE.pm", # finds $VERSION - PREREQ_PM => { Cwd => 0, - File::Spec => 0, + PREREQ_PM => { Cwd => 3.16, + File::Spec => 3.16, }, 'dist' => { COMPRESS => 'gzip -9', SUFFIX => '.gz', === lib/File/chdir.pm ================================================================== --- lib/File/chdir.pm (revision 1125) +++ lib/File/chdir.pm (local) @@ -4,7 +4,7 @@ use strict; use vars qw($VERSION @ISA @EXPORT $CWD @CWD); -$VERSION = 0.06; +$VERSION = "0.06_01"; require Exporter; @ISA = qw(Exporter); @@ -61,7 +61,8 @@ } # still /foo out here! -$CWD always returns the absolute path. +$CWD always returns the absolute path in the native form for the +operating system. $CWD and normal chdir() work together just fine. @@ -92,7 +93,8 @@ sub _abs_path () { # Otherwise we'll never work under taint mode. my($cwd) = Cwd::abs_path =~ /(.*)/; - return $cwd; + # Run through File::Spec, since everything else uses it + return File::Spec->canonpath($cwd); } my $Real_CWD; @@ -134,6 +136,11 @@ # splitdir() leaves empty directory names in place on purpose. # I don't think this is the right thing for us, but I could be wrong. + # + # dagolden: splitdir gives a leading empty string if the path is + # absolute and starts with a path separator + # unix: /home/foo -> "", "home", "foo" + # win32: c:\home\foo -. "c:", "home", "foo" sub _splitdir { return grep length, File::Spec->splitdir($_[0]); } @@ -142,8 +149,20 @@ return _splitdir(File::chdir::_abs_path); } + # dagolden: on unix, catdir() with an empty string first will give a + # path from the root (inverse of splitdir). On Win32, the first + # element in the array should be the volume, but if there are no + # arguments at all (i.e. if @CWD was cleared), then we do need an + # empty string to get back the root of the current volume sub _catdir { - return File::Spec->catdir(File::Spec->rootdir, @_); + my @dirs; + if ( $^O eq 'MSWin32' && @_ ) { + @dirs = @_; + } + else { + @dirs = ( q{}, @_ ); + } + return File::Spec->catdir( @dirs ); } sub FETCH { @@ -311,6 +330,16 @@ =head1 NOTES +C<$CWD> returns the current directory using native path separators, i.e. '\' +on Win32. This ensures that C<$CWD> will compare correctly with directories +created using File::Spec. For example: + + my $working_dir = File::Spec->catdir( $CWD, "foo" ); + $CWD = $working_dir; + doing_stuff_might_chdir(); + is( $CWD, $working_dir, "back to original working_dir?" ); + + What should %CWD do? Something with volumes? # chdir to C:\Program Files\Sierra\Half Life ? === t/array.t ================================================================== --- t/array.t (revision 1125) +++ t/array.t (local) @@ -8,10 +8,12 @@ use Cwd; -sub _catdir { - File::Spec->catdir(File::Spec->rootdir, @_); -} +# assemble directories the same way as File::chdir +BEGIN { *_catdir = \&File::chdir::ARRAY::_catdir }; +# _catdir has OS-specific path separators so do the same for getcwd +sub _getcwd { File::Spec->canonpath( getcwd ) } + my @cwd = grep length, File::Spec->splitdir(Cwd::abs_path); ok( tied @CWD, '@CWD is fit to be tied' ); @@ -19,12 +21,12 @@ # First, let's try unlocalized push @CWD. { push @CWD, 't'; - is( getcwd, _catdir(@cwd,'t'), 'unlocalized push @CWD works' ); + is( _getcwd, _catdir(@cwd,'t'), 'unlocalized push @CWD works' ); ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD set' ); is( $CWD, _catdir(@cwd,'t'), ' $CWD set' ); } -is( getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD unneffected by blocks' ); +is( _getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD unneffected by blocks' ); ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD still set' ); # reset @@ -35,13 +37,13 @@ my $popped_dir = pop @CWD; my @new_cwd = @cwd[0..$#cwd-1]; - is( getcwd, _catdir(@new_cwd), 'unlocalized pop @CWD works' ); + is( _getcwd, _catdir(@new_cwd), 'unlocalized pop @CWD works' ); is( $popped_dir, $cwd[-1], ' returns popped dir' ); ok( eq_array(\@CWD, \@new_cwd), ' @CWD set' ); is( $CWD, _catdir(@new_cwd), ' $CWD set' ); } -is( getcwd, _catdir(@cwd[0..$#cwd-1]), +is( _getcwd, _catdir(@cwd[0..$#cwd-1]), 'unlocalized @CWD unneffected by blocks' ); ok( eq_array(\@CWD, [@cwd[0..$#cwd-1]]), ' @CWD still set' ); @@ -54,14 +56,14 @@ my @spliced_dirs = splice @CWD, -2; my @new_cwd = @cwd[0..$#cwd-2]; - is( getcwd, _catdir(@new_cwd), 'unlocalized splice @CWD works' ); + is( _getcwd, _catdir(@new_cwd), 'unlocalized splice @CWD works' ); is( @spliced_dirs, 2, ' returns right # of dirs' ); ok( eq_array(\@spliced_dirs, [@cwd[-2,-1]]), " and they're correct" ); ok( eq_array(\@CWD, \@new_cwd), ' @CWD set' ); is( $CWD, _catdir(@new_cwd), ' $CWD set' ); } -is( getcwd, _catdir(@cwd[0..$#cwd-2]), +is( _getcwd, _catdir(@cwd[0..$#cwd-2]), 'unlocalized @CWD unneffected by blocks' ); ok( eq_array(\@CWD, [@cwd[0..$#cwd-2]]), ' @CWD still set' ); @@ -71,12 +73,12 @@ # Now an unlocalized assignment { @CWD = (@cwd, 't'); - is( getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD works' ); + is( _getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD works' ); ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD set' ); is( $CWD, _catdir(@cwd,'t'), ' $CWD set' ); } -is( getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD unneffected by blocks' ); +is( _getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD unneffected by blocks' ); ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD still set' ); # reset @@ -92,10 +94,10 @@ # this is a work around. local $CWD; @CWD = (@cwd, 't'); - is( getcwd, _catdir(@cwd,'t'), 'localized @CWD works' ); + is( _getcwd, _catdir(@cwd,'t'), 'localized @CWD works' ); ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD set' ); is( $CWD, _catdir(@cwd,'t'), ' $CWD set' ); } -is( getcwd, _catdir(@cwd), 'localized @CWD resets cwd' ); +is( _getcwd, _catdir(@cwd), 'localized @CWD resets cwd' ); ok( eq_array(\@CWD, \@cwd), ' @CWD reset' ); === t/chdir.t ================================================================== --- t/chdir.t (revision 1125) +++ t/chdir.t (local) @@ -8,15 +8,18 @@ use Cwd; -# Don't want to depend on File::Spec::Functions -sub catdir { File::Spec->catdir(@_); } +# assemble directories the same way as File::chdir +BEGIN { *_catdir = \&File::chdir::ARRAY::_catdir }; -my($cwd) = getcwd =~ /(.*)/; # detaint otherwise nothing's gonna work +# _catdir has OS-specific path separators so do the same for getcwd +sub _getcwd { File::Spec->canonpath( getcwd ) } +my($cwd) = _getcwd =~ /(.*)/; # detaint otherwise nothing's gonna work + # First, let's try normal chdir() { chdir('t'); - ::is( getcwd, catdir($cwd,'t'), 'void chdir still works' ); + ::is( _getcwd, _catdir($cwd,'t'), 'void chdir still works' ); chdir($cwd); # reset @@ -26,10 +29,10 @@ else { ::fail('chdir() failed completely in boolean context!'); } - ::is( getcwd, catdir($cwd,'t'), ' even in boolean context' ); + ::is( _getcwd, _catdir($cwd,'t'), ' even in boolean context' ); } -::is( getcwd, catdir($cwd,'t'), ' unneffected by blocks' ); +::is( _getcwd, _catdir($cwd,'t'), ' unneffected by blocks' ); # Ok, reset ourself for the real test. @@ -38,8 +41,8 @@ { local $ENV{HOME} = 't'; chdir; - ::is( getcwd, catdir($cwd, 't'), 'chdir() with no args' ); - ::is( $CWD, catdir($cwd, 't'), ' $CWD follows' ); + ::is( _getcwd, _catdir($cwd, 't'), 'chdir() with no args' ); + ::is( $CWD, _catdir($cwd, 't'), ' $CWD follows' ); } # Final chdir() back to the original or we confuse the debugger. === t/var.t ================================================================== --- t/var.t (revision 1125) +++ t/var.t (local) @@ -8,22 +8,25 @@ use Cwd; -# Don't want to depend on File::Spec::Functions -sub catdir { File::Spec->catdir(@_) } +# assemble directories the same way as File::chdir +BEGIN { *_catdir = \&File::chdir::ARRAY::_catdir }; -my $cwd = getcwd; +# _catdir has OS-specific path separators so do the same for getcwd +sub _getcwd { File::Spec->canonpath( getcwd ) } +my $cwd = _getcwd; + ok( tied $CWD, '$CWD is fit to be tied' ); # First, let's try unlocalized $CWD. { $CWD = 't'; - ::is( getcwd, catdir($cwd,'t'), 'unlocalized $CWD works' ); - ::is( $CWD, catdir($cwd,'t'), ' $CWD set' ); + ::is( _getcwd, _catdir($cwd,'t'), 'unlocalized $CWD works' ); + ::is( $CWD, _catdir($cwd,'t'), ' $CWD set' ); } -::is( getcwd, catdir($cwd,'t'), 'unlocalized $CWD unneffected by blocks' ); -::is( $CWD, catdir($cwd,'t'), ' and still set' ); +::is( _getcwd, _catdir($cwd,'t'), 'unlocalized $CWD unneffected by blocks' ); +::is( $CWD, _catdir($cwd,'t'), ' and still set' ); # Ok, reset ourself for the real test. @@ -33,12 +36,12 @@ my $old_dir = $CWD; local $CWD = "t"; ::is( $old_dir, $cwd, '$CWD fetch works' ); - ::is( getcwd, catdir($cwd,'t'), 'localized $CWD works' ); + ::is( _getcwd, _catdir($cwd,'t'), 'localized $CWD works' ); } -::is( getcwd, $cwd, ' and resets automatically!' ); +::is( _getcwd, $cwd, ' and resets automatically!' ); ::is( $CWD, $cwd, ' $CWD reset, too' ); chdir('t'); -is( $CWD, catdir($cwd,'t'), 'chdir() and $CWD work together' ); +is( $CWD, _catdir($cwd,'t'), 'chdir() and $CWD work together' );