From: Craig A. Berry Date: Sat, 3 Jul 2004 14:10:34 +0000 (-0500) Subject: _vms_abs_path on non-directories X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9d7d97294754b044f4b4bee93dbdfb1d82ffe0d7;p=p5sagit%2Fp5-mst-13.2.git _vms_abs_path on non-directories From: "Craig A. Berry" Message-ID: <40E704AA.4090801@mac.com> Date: Sat, 03 Jul 2004 14:10:34 -0500 p4raw-id: //depot/perl@23029 --- diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t index 816775e..8064346 100644 --- a/ext/Cwd/t/cwd.t +++ b/ext/Cwd/t/cwd.t @@ -145,30 +145,44 @@ SKIP: { unlink "linktest"; } -chdir '../ext/Cwd/t' if $ENV{PERL_CORE}; +if ($ENV{PERL_CORE}) { + chdir '../ext/Cwd/t'; + unshift @INC, '../../../lib'; +} # Make sure we can run abs_path() on files, not just directories my $path = 'cwd.t'; -dir_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file'); -dir_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file'); +path_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file'); +path_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file'); $path = File::Spec->catfile(File::Spec->updir, 't', $path); -dir_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file'); -dir_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file'); +path_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file'); +path_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file'); ############################################# -# These two routines give us sort of a poor-man's cross-platform -# directory comparison routine. +# These routines give us sort of a poor-man's cross-platform +# directory or path comparison capability. -sub bracketed_form { +sub bracketed_form_dir { return join '', map "[$_]", grep length, File::Spec->splitdir(File::Spec->canonpath( shift() )); } sub dir_ends_with { my ($dir, $expect) = (shift, shift); - my $bracketed_expect = quotemeta bracketed_form($expect); - like( bracketed_form($dir), qr|$bracketed_expect$|i, (@_ ? shift : ()) ); + my $bracketed_expect = quotemeta bracketed_form_dir($expect); + like( bracketed_form_dir($dir), qr|$bracketed_expect$|i, (@_ ? shift : ()) ); +} + +sub bracketed_form_path { + return join '', map "[$_]", + grep length, File::Spec->splitpath(File::Spec->canonpath( shift() )); +} + +sub path_ends_with { + my ($dir, $expect) = (shift, shift); + my $bracketed_expect = quotemeta bracketed_form_path($expect); + like( bracketed_form_path($dir), qr|$bracketed_expect$|i, (@_ ? shift : ()) ); } diff --git a/lib/Cwd.pm b/lib/Cwd.pm index af0c47f..37fdcfa 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -597,11 +597,11 @@ sub _vms_cwd { sub _vms_abs_path { return $ENV{'DEFAULT'} unless @_; + + # may need to turn foo.dir into [.foo] my $path = VMS::Filespec::pathify($_[0]); - if (! defined $path) - { - _croak("Invalid path name $_[0]") - } + $path = $_[0] unless defined $path; + return VMS::Filespec::rmsexpand($path); }