Merge changes from PathTools: 'Update to support VMS in Unix compatible mode and...

[p5sagit/p5-mst-13.2.git] / ext / Cwd / t / cwd.t

diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t
index 7d5f67f..8e86c4d 100644 (file)
--- a/ext/Cwd/t/cwd.t
+++ b/ext/Cwd/t/cwd.t
@@ -16,7 +16,30 @@ use File::Path;
 
 use lib File::Spec->catdir('t', 'lib');
 use Test::More;
-require VMS::Filespec if $^O eq 'VMS';
+
+my $IsVMS = $^O eq 'VMS';
+my $IsMacOS = $^O eq 'MacOS';
+
+my $vms_unix_rpt = 0;
+my $vms_efs = 0;
+my $vms_mode = 0;
+
+if ($IsVMS) {
+    require VMS::Filespec;
+    use Carp;
+    use Carp::Heavy;
+    $vms_mode = 1;
+    if (eval 'require VMS::Feature') {
+        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+        $vms_efs = VMS::Feature::current("efs_charset");
+    } else {
+        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 
+        $vms_efs = $efs_charset =~ /^[ET1]/i; 
+    }
+    $vms_mode = 0 if ($vms_unix_rpt);
+}
 
 my $tests = 30;
 # _perl_abs_path() currently only works when the directory separator
@@ -30,8 +53,6 @@ SKIP: {
   like $INC{'Cwd.pm'}, qr{blib}i, "Cwd should be loaded from blib/ during testing";
 }
 
-my $IsVMS = $^O eq 'VMS';
-my $IsMacOS = $^O eq 'MacOS';
 
 # check imports
 can_ok('main', qw(cwd getcwd fastcwd fastgetcwd));
@@ -80,8 +101,17 @@ SKIP: {
 
     # Win32's cd returns native C:\ style
     $start =~ s,\\,/,g if ($^O eq 'MSWin32' || $^O eq "NetWare");
-    # DCL SHOW DEFAULT has leading spaces
-    $start =~ s/^\s+// if $IsVMS;
+    if ($IsVMS) {
+        # DCL SHOW DEFAULT has leading spaces
+        $start =~ s/^\s+//;
+
+        # When in UNIX report mode, need to convert to compare it.
+        if ($vms_unix_rpt) {
+            $start = VMS::Filespec::unixpath($start);
+            # Remove trailing slash.
+            $start =~ s#/$##;
+        }
+    }
     SKIP: {
         skip("'$pwd_cmd' failed, nothing to test against", 4) if $?;
         skip("/afs seen, paths unlikely to match", 4) if $start =~ m|/afs/|;
@@ -144,9 +174,9 @@ for (1..@test_dirs) {
 rmtree($test_dirs[0], 0, 0);
 
 {
-  my $check = ($IsVMS   ? qr|\b((?i)t)\]$| :
-              $IsMacOS ? qr|\bt:$| :
-                         qr|\bt$| );
+  my $check = ($vms_mode ? qr|\b((?i)t)\]$| :
+              $IsMacOS  ? qr|\bt:$| :
+                          qr|\bt$| );
   
   like($ENV{PWD}, $check);
 }
@@ -169,7 +199,18 @@ SKIP: {
 
     my $abs_path      =  Cwd::abs_path($file);
     my $fast_abs_path =  Cwd::fast_abs_path($file);
-    my $want          =  quotemeta( File::Spec->rel2abs($Test_Dir) );
+    my $want          =  quotemeta(
+                           File::Spec->rel2abs( $Test_Dir )
+                         );
+    if ($^O eq 'VMS') {
+       # Not easy to predict the physical volume name
+       $want = $ENV{PERL_CORE} ? $Test_Dir : File::Spec->catdir('t', $Test_Dir);
+
+       # So just use the relative volume name
+       $want =~ s/^\[//;
+
+       $want = quotemeta($want);
+    }
 
     like($abs_path,      qr|$want$|i);
     like($fast_abs_path, qr|$want$|i);