Add symlink support to Cwd::_vms_abs_path.
Craig A. Berry [Sat, 6 Oct 2007 18:28:59 +0000 (18:28 +0000)]
p4raw-id: //depot/perl@32053

ext/Cwd/t/cwd.t
lib/Cwd.pm

index 4ec7b9a..148682a 100644 (file)
@@ -173,14 +173,18 @@ SKIP: {
 
     my $abs_path      =  Cwd::abs_path("linktest");
     my $fast_abs_path =  Cwd::fast_abs_path("linktest");
-    my $want          =  File::Spec->catdir("t", $Test_Dir);
+    my $want          =  quotemeta(
+                             File::Spec->rel2abs(
+                                $ENV{PERL_CORE} ? $Test_Dir : File::Spec->catdir('t', $Test_Dir)
+                                                )
+                                  );
 
-    like($abs_path,      qr|$want$|);
-    like($fast_abs_path, qr|$want$|);
-    like(Cwd::_perl_abs_path("linktest"), qr|$want$|) if $EXTRA_ABSPATH_TESTS;
+    like($abs_path,      qr|$want$|i);
+    like($fast_abs_path, qr|$want$|i);
+    like(Cwd::_perl_abs_path("linktest"), qr|$want$|i) if $EXTRA_ABSPATH_TESTS;
 
     rmtree($test_dirs[0], 0, 0);
-    unlink "linktest";
+    1 while unlink "linktest";
 }
 
 if ($ENV{PERL_CORE}) {
index a4ef00c..2053f05 100644 (file)
@@ -171,7 +171,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.25';
+$VERSION = '3.25_01';
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -644,11 +644,19 @@ sub _vms_cwd {
 
 sub _vms_abs_path {
     return $ENV{'DEFAULT'} unless @_;
+    my $path = shift;
 
-    # may need to turn foo.dir into [.foo]
-    my $path = VMS::Filespec::pathify($_[0]);
-    $path = $_[0] unless defined $path;
+    if (-l $path) {
+        my $link_target = readlink($path);
+        die "Can't resolve link $path: $!" unless defined $link_target;
+           
+        return _vms_abs_path($link_target);
+    }
 
+    # may need to turn foo.dir into [.foo]
+    my $pathified = VMS::Filespec::pathify($path);
+    $path = $pathified if defined $pathified;
+       
     return VMS::Filespec::rmsexpand($path);
 }