Skip Menu |
 

This queue is for tickets about the File-chdir CPAN distribution.

Report information
The Basics
Id: 3257
Status: resolved
Priority: 0/
Queue: File-chdir

People
Owner: Nobody in particular
Requestors: muenalan [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.06
Fixed in: 0.07



Subject: [perl5.8.0/win32] FAILED TESTS
Download (untitled) / with headers
text/plain 5.9k
Show quoted text
cpan> install File::chdir
Running install for module File::chdir Running make for M/MS/MSCHWERN/File-chdir-0.06.tar.gz Fetching with LWP: ftp://theoryx5.uwinnipeg.ca/pub/CPAN/authors/id/M/MS/MSCHWERN/File-chdir-0.06.tar.gz CPAN: Digest::MD5 loaded ok Fetching with LWP: ftp://theoryx5.uwinnipeg.ca/pub/CPAN/authors/id/M/MS/MSCHWERN/CHECKSUMS Checksum for V:\.cpan\sources\authors\id\M\MS\MSCHWERN\File-chdir-0.06.tar.gz ok Scanning cache V:\.cpan\build for sizes Deleting from cache: V:\.cpan\build\Config-Simple-4.53 (10.0>10.0 MB) File-chdir-0.06/ File-chdir-0.06/Changes File-chdir-0.06/lib/ File-chdir-0.06/lib/File/ File-chdir-0.06/lib/File/chdir.pm File-chdir-0.06/Makefile.PL File-chdir-0.06/MANIFEST File-chdir-0.06/META.yml File-chdir-0.06/t/ File-chdir-0.06/t/array.t File-chdir-0.06/t/chdir.t File-chdir-0.06/t/lib/ File-chdir-0.06/t/lib/Test/ File-chdir-0.06/t/lib/Test/Builder.pm File-chdir-0.06/t/lib/Test/More.pm File-chdir-0.06/t/lib/Test/Simple.pm File-chdir-0.06/t/var.t CPAN.pm: Going to build M/MS/MSCHWERN/File-chdir-0.06.tar.gz Checking if your kit is complete... Looks good Writing Makefile for File::chdir Microsoft (R) Program Maintenance Utility Version 1.50 Copyright (c) Microsoft Corp 1988-94. All rights reserved. cp lib/File/chdir.pm blib\lib\File\chdir.pm w:\bin\nmake -- OK Running make test Microsoft (R) Program Maintenance Utility Version 1.50 Copyright (c) Microsoft Corp 1988-94. All rights reserved. C:\Programme\Perl\bin\perl.exe "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib\lib', 'blib\arch')" t\array.t t\chdir.t t\var.t t\array....ok 1/31Insecure dependency in chdir while running with -T switch at C:/Programme/Perl/lib/Cwd.pm line 421. # Looks like you planned 31 tests but only ran 1. # Looks like your test died just after 1. t\array....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED tests 2-31 Failed 30/31 tests, 3.23% okay t\chdir....ok 1/6# Failed test (t\chdir.t at line 19) t\chdir....NOK 2# got: 'V:/.cpan/build/File-chdir-0.06/t' # expected: 'V:\.cpan\build\File-chdir-0.06\t' # Failed test (t\chdir.t at line 29) t\chdir....NOK 3# got: 'V:/.cpan/build/File-chdir-0.06/t' # expected: 'V:\.cpan\build\File-chdir-0.06\t' # Failed test (t\chdir.t at line 32) t\chdir....NOK 4# got: 'V:/.cpan/build/File-chdir-0.06/t' # expected: 'V:\.cpan\build\File-chdir-0.06\t' # Failed test (t\chdir.t at line 41) t\chdir....NOK 5# got: 'V:/.cpan/build/File-chdir-0.06/t' # expected: 'V:\.cpan\build\File-chdir-0.06\t' Insecure dependency in chdir while running with -T switch at C:/Programme/Perl/lib/Cwd.pm line 421. # Looks like you planned 6 tests but only ran 5. # Looks like your test died just after 5. t\chdir....dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED tests 2-6 Failed 5/6 tests, 16.67% okay t\var......ok 2/11Insecure dependency in chdir while running with -T switch at C:/Programme/Perl/lib/Cwd.pm line 421. # Looks like you planned 11 tests but only ran 2. # Looks like your test died just after 2. t\var......dubious Test returned status 255 (wstat 65280, 0xff00) DIED. FAILED tests 3-11 Failed 9/11 tests, 18.18% okay Failed Test Stat Wstat Total Fail Failed List of Failed ------------------------------------------------------------------------------- t\array.t 255 65280 31 60 193.55% 2-31 t\chdir.t 255 65280 6 6 100.00% 2-6 t\var.t 255 65280 11 18 163.64% 3-11 Failed 3/3 test scripts, 0.00% okay. 44/48 subtests failed, 8.33% okay. NMAKE : fatal error U1077: 'C:\WINDOWS\system32\cmd.exe' : return code '0x2' Stop. w:\bin\nmake test -- NOT OK Running make install make test had returned bad status, won't install without force --- Summary of my perl5 (revision 5 version 8 subversion 0) configuration: Platform: osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread uname='' config_args='undef' hint=recommended, useposix=true, d_sigaction=undef usethreads=undef use5005threads=undef useithreads=define usemultiplicity=define useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cl', ccflags ='-nologo -Gf -W3 -MD -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READF IX', optimize='-MD -DNDEBUG -O1', cppflags='-DWIN32' ccversion='', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='link', ldflags ='-nologo -nodefaultlib -libpath:"C:\Programme\Perl\lib\CORE" -machine:x86' libpth=\lib libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm. lib version.lib odbc32.lib odbccp32.lib msvcrt.lib perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib wi nmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib gnulibc_version='undef' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -libpath:"C:\Programme\Perl\lib\CORE" -machine:x86' Characteristics of this binary (from libperl): Compile-time options: MULTIPLICITY USE_ITHREADS USE_LARGE_FILES PERL_IMPLICIT_CONTEXT PERL_IMPLICIT_SYS Locally applied patches: ActivePerl Build 806 Built under MSWin32 Compiled at Apr 24 2003 20:37:33 @INC: C:/Programme/Perl/lib C:/Programme/Perl/site/lib .
Date: Fri, 15 Aug 2003 18:47:07 -0700
From: Michael G Schwern <schwern [...] pobox.com>
To: Guest via RT <bug-File-chdir [...] rt.cpan.org>
CC: "AdminCc of cpan Ticket #3257": ;
Subject: Re: [cpan #3257] [perl5.8.0/win32] FAILED TESTS
RT-Send-Cc:
Download (untitled) / with headers
text/plain 2.6k
On Fri, Aug 15, 2003 at 12:50:43PM -0400, Guest via RT wrote: Show quoted text
> t\array....ok 1/31Insecure dependency in chdir while running with -T switch at C:/Programme/Perl/lib/Cwd.pm line 421.
That's Cwd::fast_abs_path() blowing up in taint mode. File::chdir is using Cwd::abs_path() which is supposed to work in taint mode but on non-Unix its aliased to fast_abs_path(). I've submitted a patch to fix fast_abs_path() so it works in taint mode. Meanwhile, either ignore the test errors (you can remove the -T's at the top of the file) or patch Cwd. Don't know what I'm going to do about this as it will continue to effect non-Unixen running < 5.8.1 --- Cwd.pm 2003/08/16 01:25:50 1.1 +++ Cwd.pm 2003/08/16 01:35:50 @@ -38,8 +38,6 @@ Re-implements the getcwd(3) (or getwd(3)) functions in Perl. -Taint-safe. - =item cwd my $cwd = cwd(); @@ -48,8 +46,6 @@ most systems it is identical to `pwd` (but without the trailing line terminator). -Taint-safe. - =item fastcwd my $cwd = fastcwd(); @@ -77,7 +73,8 @@ =head2 abs_path and friends These functions are exported only on request. They each take a single -argument and return the absolute pathname for it. +argument and return the absolute pathname for it. If no argument is +given they'll use the current working directory. =over 4 @@ -89,25 +86,18 @@ components ("." and "..") are resolved to return the canonical pathname, just like realpath(3). -Taint-safe. - =item realpath my $abs_path = realpath($file); A synonym for abs_path(). -Taint-safe. - =item fast_abs_path my $abs_path = fast_abs_path($file); A more dangerous, but potentially faster version of abs_path. -This function is B<Not> taint-safe : you can't use it in programs -that work under taint mode. - =back =head2 $ENV{PWD} @@ -177,7 +167,7 @@ eval { require XSLoader; - undef *Cwd::fastcwd; # avoid redefinition warning + no warnings 'redefine'; XSLoader::load('Cwd'); }; @@ -422,10 +412,17 @@ # used to the libc function. --tchrist 27-Jan-00 *realpath = \&abs_path; +my $Curdir; sub fast_abs_path { my $cwd = getcwd(); require File::Spec; - my $path = @_ ? shift : File::Spec->curdir; + my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir); + + # Detaint else we'll explode in taint mode. This is safe because + # we're only doing anything dangerous with it. + ($path) = $path =~ /(.*)/; + ($cwd) = $cwd =~ /(.*)/; + CORE::chdir($path) || croak "Cannot chdir to $path: $!"; my $realpath = getcwd(); -d $cwd && CORE::chdir($cwd) || -- Michael G Schwern schwern@pobox.com http://www.pobox.com/~schwern/
From: muenalan [...] cpan.org
Download (untitled) / with headers
text/plain 392b
[schwern@pobox.com - Fri Aug 15 21:47:20 2003]: [snip] Show quoted text
> top of the file) or patch Cwd. Don't know what I'm going to do about > this as it will continue to effect non-Unixen running < 5.8.1
Dont rely on Cwd::abs_path() ? Use File::Spec ? Honestly i am not so curious about the Taint mode stuff, but more about the platform independence and the correct symbols (/ vs \). Greetings, Murat
Download (untitled) / with headers
text/plain 513b
Sorry for taking so long to get back to this. I've investigated the problem and there's multiple sources of cross-platform issues. Cwd::abs_path() is returning directories in a non-native format (C:/foo/bar instead of C:\foo\bar). My internal conversions from an array to an absolute path don't work so well with volumes. And there's a bug in File::Spec->rootdir on Win32 (it returns / instead of \). I'll have to tear up a lot of the code to fix all this but I have access to a Windows machine now to do it.
From: Alexandr Ciornii <alexchorny [...] gmail.com>
Download (untitled) / with headers
text/plain 620b
On Apr. 15 16:55:57 2005, MSCHWERN wrote: Show quoted text
> I've investigated the problem and there's multiple sources of > cross-platform issues. Cwd::abs_path() is returning directories in a > non-native format (C:/foo/bar instead of C:\foo\bar). My internal > conversions from an array to an absolute path don't work so well with > volumes. And there's a bug in File::Spec->rootdir on Win32 (it returns > / instead of \).
rootdir() error was fixed in PathTools 3.07. But tests still fail with PathTools 3.18. Your bug #12306 was not answered. If I skip tests, will File::chdir work correctly or errors will influence it's work?
From: theultramage [...] gmail.com
Download (untitled) / with headers
text/plain 213b
At the moment I can see that the patch has been officially applied, but it's still giving / paths instead of \ paths. This is making many tests that depend on the module fail. Any idea if/when it will be fixed?
From: MSCHWERN [...] cpan.org
Download (untitled) / with headers
text/plain 724b
On Tue Dec 26 09:08:02 2006, theultramage wrote: Show quoted text
> At the moment I can see that the patch has been officially applied, but > it's still giving / paths instead of \ paths. This is making many tests > that depend on the module fail.
Are you talking about a patch to Pathtools? Because I haven't applied anything to File::chdir. Show quoted text
> Any idea if/when it will be fixed?
Well, I just discovered a File::chdir directory on my hard drive which appears to be an old attempt of mine to fix this. I'm not sure what state its in and my Windows machine is on the other side of the country just now. It feels a bit overcomplicated anyway. I can't do anything with it until next week the earliest. Maybe you can, I've attached it.
Download File-chdir.patch
text/x-diff 6.5k
=== MANIFEST ================================================================== --- MANIFEST (revision 26468) +++ MANIFEST (local) @@ -8,3 +8,4 @@ t/lib/Test/More.pm t/lib/Test/Simple.pm t/var.t +META.yml Module meta-data (added by MakeMaker) === lib/File/chdir.pm ================================================================== --- lib/File/chdir.pm (revision 26468) +++ 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); @@ -92,14 +92,22 @@ sub _abs_path () { # Otherwise we'll never work under taint mode. my($cwd) = Cwd::abs_path =~ /(.*)/; - return $cwd; + + # Cwd likes to do things like use / on Windows. Normalize all that. + return File::Spec->canonpath($cwd); } my $Real_CWD; sub _chdir ($) { my($new_dir) = @_; - my $Real_CWD = File::Spec->catdir(_abs_path(), $new_dir); + $new_dir = File::Spec->canonpath($new_dir); + if( File::Spec->file_name_is_absolute($new_dir) ) { + $Real_CWD = $new_dir; + } + else { + $Real_CWD = File::Spec->catdir(_abs_path(), $new_dir); + } return CORE::chdir($new_dir); } @@ -132,16 +140,22 @@ bless {}, $_[0]; } - # 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. sub _splitdir { - return grep length, File::Spec->splitdir($_[0]); + return File::Spec->splitdir($_[0]); } - sub _cwd_list { + sub _raw_cwd_list { return _splitdir(File::chdir::_abs_path); } + # splitdir() uses '' to indicate the root directory. Since + # @CWD is always absolute we can strip this off. + sub _cwd_list { + return grep length, _raw_cwd_list; + } + sub _catdir { return File::Spec->catdir(File::Spec->rootdir, @_); } @@ -154,13 +168,14 @@ sub STORE { my($self, $idx, $val) = @_; + $val = '/' if $val eq ''; my @cwd = (); if( $self->{Cleared} ) { $self->{Cleared} = 0; } else { - @cwd = _cwd_list; + @cwd = _raw_cwd_list; } $cwd[$idx] = $val; @@ -298,6 +313,8 @@ =head1 BUGS and CAVEATS +=head3 C<local @CWD> does not work. + C<local @CWD> will not localize C<@CWD>. This is a bug in Perl, you can't localize tied arrays. As a work around localizing $CWD will effectively localize @CWD. @@ -309,6 +326,11 @@ } +=head3 Volumes not handled + +There is currently no way to change the current volume via File::chdir. + + =head1 NOTES What should %CWD do? Something with volumes? === t/array.t ================================================================== --- t/array.t (revision 26468) +++ t/array.t (local) @@ -2,30 +2,48 @@ use strict; use lib qw(t/lib); -use Test::More tests => 31; +use Test::More tests => 32; BEGIN { use_ok('File::chdir') } -use Cwd; +# Cwd tends to use / instead of \. +sub getcwd { + return File::chdir::_abs_path; +} sub _catdir { - File::Spec->catdir(File::Spec->rootdir, @_); + File::Spec->catdir(@_); } -my @cwd = grep length, File::Spec->splitdir(Cwd::abs_path); +my @cwd = File::Spec->splitdir(Cwd::abs_path); +sub _cwd_ok { + my($tied_got, $expected) = @_; + my @got = @$tied_got; # untie it so we can modify it + + # Stick the / back on the front + unshift @got, ''; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + is( File::Spec->canonpath(File::Spec->catdir(@got)), + File::Spec->canonpath(File::Spec->catdir(@$expected)) ); +} + ok( tied @CWD, '@CWD is fit to be tied' ); +isnt @CWD, '', '@CWD should not start with "" like splitdir does'; + # First, let's try unlocalized push @CWD. { push @CWD, 't'; is( getcwd, _catdir(@cwd,'t'), 'unlocalized push @CWD works' ); - ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD set' ); + _cwd_ok(\@CWD, [@cwd, 't'], ' @CWD set' ); is( $CWD, _catdir(@cwd,'t'), ' $CWD set' ); } is( getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD unneffected by blocks' ); -ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD still set' ); +_cwd_ok(\@CWD, [@cwd, 't'], ' @CWD still set' ); # reset @CWD = @cwd; @@ -37,13 +55,13 @@ 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' ); + _cwd_ok(\@CWD, \@new_cwd, ' @CWD set' ); is( $CWD, _catdir(@new_cwd), ' $CWD set' ); } is( getcwd, _catdir(@cwd[0..$#cwd-1]), 'unlocalized @CWD unneffected by blocks' ); -ok( eq_array(\@CWD, [@cwd[0..$#cwd-1]]), ' @CWD still set' ); +_cwd_ok(\@CWD, [@cwd[0..$#cwd-1]], ' @CWD still set' ); # reset @CWD = @cwd; @@ -56,14 +74,14 @@ 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_deeply(\@spliced_dirs, [@cwd[-2,-1]], " and they're correct" ); + _cwd_ok(\@CWD, \@new_cwd, ' @CWD set' ); is( $CWD, _catdir(@new_cwd), ' $CWD set' ); } is( getcwd, _catdir(@cwd[0..$#cwd-2]), 'unlocalized @CWD unneffected by blocks' ); -ok( eq_array(\@CWD, [@cwd[0..$#cwd-2]]), ' @CWD still set' ); +_cwd_ok(\@CWD, [@cwd[0..$#cwd-2]], ' @CWD still set' ); # reset @CWD = @cwd; @@ -72,12 +90,12 @@ { @CWD = (@cwd, 't'); is( getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD works' ); - ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD set' ); + _cwd_ok(\@CWD, [@cwd, 't'], ' @CWD set' ); is( $CWD, _catdir(@cwd,'t'), ' $CWD set' ); } is( getcwd, _catdir(@cwd,'t'), 'unlocalized @CWD unneffected by blocks' ); -ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD still set' ); +_cwd_ok(\@CWD, [@cwd, 't'], ' @CWD still set' ); # reset @CWD = @cwd; @@ -93,9 +111,9 @@ local $CWD; @CWD = (@cwd, 't'); is( getcwd, _catdir(@cwd,'t'), 'localized @CWD works' ); - ok( eq_array(\@CWD, [@cwd, 't']), ' @CWD set' ); + _cwd_ok(\@CWD, [@cwd, 't'], ' @CWD set' ); is( $CWD, _catdir(@cwd,'t'), ' $CWD set' ); } is( getcwd, _catdir(@cwd), 'localized @CWD resets cwd' ); -ok( eq_array(\@CWD, \@cwd), ' @CWD reset' ); +_cwd_ok(\@CWD, \@cwd, ' @CWD reset' );
Download (untitled) / with headers
text/plain 359b
On Sun Jul 09 16:28:53 2006, guest wrote: Show quoted text
> rootdir() error was fixed in PathTools 3.07. But tests still fail with > PathTools 3.18. Your bug #12306 was not answered. > > If I skip tests, will File::chdir work correctly or errors will > influence it's work?
If the failures are just of the form "expected foo\bar, got foo/bar" then it should work correctly.
Download (untitled) / with headers
text/plain 577b
This patch fixes all of the problems of File::chdir on Win32 (with PathTools 3.24). FYI, the problems were: 1) because File::Spec->rootdir on Win32 returns '\' (which might not be a good idea, anyway), _catdir for File::chdir::ARRAY returns something like '\C:\foo\bar\baz', and CORE::chdir refuses to change dir (as it is not right path for Win because of the preceding slash). 2) And omnipresent back slash/forward slash issue when comparing paths on Win32. perl itself accepts both slashes, so we need this conversion in the test suites only. Hope this helps you.
Download File-chdir-patch
application/octet-stream 1.8k

Message body not shown because it is not plain text.

Subject: [win32] Tests fail due to path separators and prepended rootdir
Download (untitled) / with headers
text/plain 613b
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' );
Resolved in 0.07


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.