From: John Malmberg <wb8tyw@gmail.com>
Date: Sun, 4 Jan 2009 19:06:54 +0000 (-0600)
Subject: ext/File/Gob/t/basic.t, ext/POSIX/t/posix.t vms fixes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6a164b5b33cb5272af43c3c4bc6dbfa7534d90db;p=p5sagit%2Fp5-mst-13.2.git

ext/File/Gob/t/basic.t, ext/POSIX/t/posix.t vms fixes

Message-id: <496108CE.1060704@gmail.com>

The tests ext/File/Glob/t/basic.t and ext/POSIX/t/posix.t need to know
if VMS is in the UNIX compatible mode.
---

diff --git a/ext/File/Glob/t/basic.t b/ext/File/Glob/t/basic.t
index bdb2c57..b9d46b1 100755
--- a/ext/File/Glob/t/basic.t
+++ b/ext/File/Glob/t/basic.t
@@ -19,6 +19,23 @@ use Test::More tests => 14;
 BEGIN {use_ok('File::Glob', ':glob')};
 use Cwd ();
 
+my $vms_unix_rpt = 0;
+my $vms_efs = 0;
+my $vms_mode = 0;
+if ($^O eq 'VMS') {
+    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 = 1 unless ($vms_unix_rpt);
+}
+
+
 # look for the contents of the current directory
 $ENV{PATH} = "/bin";
 delete @ENV{qw(BASH_ENV CDPATH ENV IFS)};
@@ -109,7 +126,7 @@ is_deeply(\@a, ['a', 'b']);
 
 print "# @a\n";
 
-is_deeply(\@a, [($^O eq 'VMS'? 'test.' : 'TEST'), 'a', 'b']);
+is_deeply(\@a, [($vms_mode ? 'test.' : 'TEST'), 'a', 'b']);
 
 # "~" should expand to $ENV{HOME}
 $ENV{HOME} = "sweet home";
diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t
index 2da3b43..9366532 100644
--- a/ext/POSIX/t/posix.t
+++ b/ext/POSIX/t/posix.t
@@ -28,6 +28,28 @@ $Is_OS2     = $^O eq 'os2';
 $Is_UWin    = $^O eq 'uwin';
 $Is_OS390   = $^O eq 'os390';
 
+my $vms_unix_rpt = 0;
+my $vms_efs = 0;
+my $unix_mode = 1;
+
+if ($Is_VMS) {
+    $unix_mode = 0;
+    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;
+    }
+
+    # Traditional VMS mode only if VMS is not in UNIX compatible mode.
+    $unix_mode = ($vms_efs && $vms_unix_rpt);
+
+}
+
+
 ok( $testfd = open("TEST", O_RDONLY, 0),        'O_RDONLY with open' );
 read($testfd, $buffer, 4) if $testfd > 2;
 is( $buffer, "#!./",                      '    with read' );
@@ -128,11 +150,11 @@ my $pat;
 if ($Is_MacOS) {
     $pat = qr/:t:$/;
 } 
-elsif ( $Is_VMS ) {
-    $pat = qr/\.T]/i;
+elsif ( $unix_mode ) {
+    $pat = qr#[\\/]t$#i;
 }
 else {
-    $pat = qr#[\\/]t$#i;
+    $pat = qr/\.T]/i;
 }
 like( getcwd(), qr/$pat/, 'getcwd' );