A quick and dirty hack for spec.t so that tests will produce valid
results when the CRTL is in UNIX mode. I am sure that there is a better
way to do this.
I had the same problem with the the file that becomes vmsfspec.t, but
was unable to find a way to modify it to work with the CRTL in POSIX
mode and UNIX REPORT mode, and still have it work for the traditional
VMS modes.
In crossplatform.t, when the CRTL is in UNIX mode, and you give it the
components of a path that would be valid on UNIX, you will get a UNIX
path as a result.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- lib/File/Spec/t/Spec.t_5_8_6 Tue Apr 26 18:57:00 2005
+++ lib/File/Spec/t/Spec.t Mon Jun 6 14:59:44 2005
@@ -29,6 +29,54 @@
}
require File::Spec::VMS ;
+# VMS can pretend it is UNIX.
+
+my $IsVMS = $^O eq 'VMS';
+my $posix_compliant;
+my $unix_report;
+my $unix_only;
+my $case_preserved = 1;
+my $vms_drop_dot;
+my $vms_format = 0;
+if ($IsVMS) {
+ $vms_format = 1;
+ $posix_compliant = $ENV{'DECC$POSIX_COMPLIANT_PATHNAMES'};
+ if (defined $posix_compliant) {
+ if (($posix_compliant lt '1') && ($posix_compliant ne 'ENABLE')) {
+ $posix_compliant = undef;
+ }
+ }
+ $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'};
+ if (defined $unix_report) {
+ if (($unix_report lt '1') && ($unix_report ne 'ENABLE')) {
+ $unix_report = undef;
+ }
+ }
+ $unix_only = $ENV{'DECC$FILENAME_UNIX_ONLY'};
+ if (defined $unix_only) {
+ if (($unix_only lt '1') && ($unix_only ne 'ENABLE')) {
+ $unix_only = undef;
+ }
+ }
+ $unix_report = 1 if (defined $unix_only);
+
+ $case_preserved = $ENV{'DECC$EFS_CASE_PRESERVE'};
+ if (defined $case_preserved) {
+ if (($case_preserved lt '1') && ($case_preserved ne 'ENABLE')) {
+ $case_preserved = undef;
+ }
+ }
+ $vms_drop_dot = $ENV{'DECC$READDIR_DROPDOTNOTYPE'};
+ if (defined $vms_drop_dot) {
+ if (($vms_drop_dot lt '1') && ($vms_drop_dot ne 'ENABLE')) {
+ $vms_drop_dot = undef;
+ }
+ }
+ if ((defined $unix_report) && (defined $vms_drop_dot)) {
+ $vms_format = 0
+ }
+}
+
require File::Spec::OS2 ;
require File::Spec::Mac ;
require File::Spec::Epoc ;
@@ -658,6 +706,153 @@
ok $@, '', $function;
}
return;
+ }
+
+ # VMS may pretend it is UNIX, so hacks are need when in that mode.
+ # someone better at perl than I am will probably need to help me
+ # clean this up.
+
+ if ($IsVMS && defined($unix_report) && $expected ne $got) {
+
+ print ("#VMS in UNIX Report mode:, \'$function\' \n");
+
+ # VMS is not always case_tolerant
+ if ($function eq 'File::Spec::VMS->case_tolerant()') {
+ if (defined $case_preserved) {
+ if ($got eq 0) {
+ print "#VMS in case sensitive mode.\n";
+ $expected = $got;
+ }
+ }
+ }
+ elsif ($function eq "File::Spec::VMS->catfile('a','b','c')" ) {
+ $expected = 'a/b/c'
+ }
+ elsif ($function eq "File::Spec::VMS->catfile('a','b','[]c')" ) {
+ $expected = '[.a.b]c.'
+ }
+ elsif ($function eq "File::Spec::VMS->catfile('[.a]','b','c')" ) {
+ $expected = '[.a.b]c.'
+ }
+ elsif ($function eq "File::Spec::VMS->catfile('[]c')" ) {
+ $expected = 'c.'
+ }
+ elsif ($function eq "File::Spec::VMS->splitpath('d1/d2/d3/file')" ) {
+ $expected = ',d1/d2/d3/,file'
+ }
+ elsif ($function eq "File::Spec::VMS->splitpath('/d1/d2/d3/file')" ) {
+ $expected = ',/d1/d2/d3/,file'
+ }
+ elsif ($function eq "File::Spec::VMS->catpath('','d1/d2/d3','file')" ) {
+ $expected = 'd1/d2/d3/file'
+ }
+# Need to rewrite vms canonpath() to understand EFS, hack these temporarily.
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[000000.d1]d2.dir;1')" ) {
+ $expected = 'volume:[d1]d2.dir'
+ }
+ elsif ($function eq "File::Spec::VMS->canonpath('[d1.d2.d3]file.txt')" )
{
+ $expected = 'sys$disk:[d1.d2.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[-.d1.d2.d3]file.txt')" ) {
+ $expected = 'volume:[t.-.d1.d2.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[--.d1.d2.d3]file.txt')" ) {
+ $expected = 'volume:[t.--.d1.d2.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.-.d2.d3]file.txt')" ) {
+ $expected = 'volume:[d1.-.d2.d3]file.txt'
+ }
+ elsif ($function eq "File::Spec::VMS->canonpath('[d1.-.d2.d3]file.txt')"
) {
+ $expected = 'sys$disk:[d1.-.d2.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')" ) {
+ $expected = 'volume:[d1.-.d2.d3.d4.-]'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.--.d2.d3]file.txt')" ) {
+ $expected = 'volume:[d1.--.d2.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('[d1.--.d2.d3]file.txt')" ) {
+ $expected = 'sys$disk:[d1.--.d2.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.d2.-.d3]file.txt')" ) {
+ $expected = 'volume:[d1.d2.-.d3]file.txt'
+ }
+ elsif ($function eq "File::Spec::VMS->canonpath('[d1.d2.-.d3]file.txt')"
) {
+ $expected = 'sys$disk:[d1.d2.-.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.d2.--.d3]file.txt')" ) {
+ $expected = 'volume:[d1.d2.--.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('[d1.d2.--.d3]file.txt')" ) {
+ $expected = 'sys$disk:[d1.d2.--.d3]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.d2.d3.-]file.txt')" ) {
+ $expected = 'volume:[d1.d2.d3.-]file.txt'
+ }
+ elsif ($function eq "File::Spec::VMS->canonpath('[d1.d2.d3.-]file.txt')"
) {
+ $expected = 'sys$disk:[d1.d2.d3.-]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.d2.d3.--]file.txt')" ) {
+ $expected = 'volume:[d1.d2.d3.--]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('[d1.d2.d3.--]file.txt')" ) {
+ $expected = 'sys$disk:[d1.d2.d3.--]file.txt'
+ }
+#gigo
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.000000.][000000.][d3.--]file.txt')" ) {
+ $expected = 'volume:[d1.000000.][000000.][d3.--]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('[d1.000000.][000000.][d3.--]file.txt')" ) {
+ $expected = '[d1.000000.][000000.][d3.--]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.000000.][000000.][d2.000000]file.txt')"
) {
+ $expected = 'volume:[d1.000000.][000000.][d2.000000]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('[d1.000000.][000000.][d2.000000]file.txt')" ) {
+ $expected = '[d1.000000.][000000.][d2.000000]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.000000.][000000.][d3.--.000000]file.txt')"
) {
+ $expected = 'volume:[d1.000000.][000000.][d3.--.000000]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('[d1.000000.][000000.][d3.--.000000]file.txt')" ) {
+ $expected = '[d1.000000.][000000.][d3.--.000000]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('volume:[d1.000000.][000000.][-.-.000000]file.txt')"
) {
+ $expected = 'volume:[d1.000000.][000000.][-.-.000000]file.txt'
+ }
+ elsif ($function eq
"File::Spec::VMS->canonpath('[d1.000000.][000000.][--.-.000000]file.txt')" ) {
+ $expected = '[d1.000000.][000000.][--.-.000000]file.txt'
+ }
+ elsif ($function eq "File::Spec::VMS->canonpath('[d1.d2.--]file')" ) {
+ $expected = 'sys$disk:[d1.d2.--]file'
+ }
+ elsif ($function eq "File::Spec::VMS->splitdir('d1.d2.d3')" ) {
+ $expected = 'd1.d2.d3'
+ }
+ elsif ($function eq "File::Spec::VMS->splitdir('.d1.d2.d3')" ) {
+ $expected = '.d1.d2.d3'
+ }
+ elsif ($function eq "File::Spec::VMS->splitdir('.-.d2.d3')" ) {
+ $expected = '.-.d2.d3'
+ }
+ elsif ($function eq "File::Spec::VMS->catdir('d1','d2','d3')" ) {
+ $expected = 'd1/d2/d3'
+ }
+ elsif ($function eq "File::Spec::VMS->catdir('d1','d2/','d3')" ) {
+ $expected = 'd1/d2/d3'
+ }
+ elsif ($function eq "File::Spec::VMS->catdir('','d1','d2','d3')" ) {
+ $expected = 'd1/d2/d3'
+ }
+ elsif ($function eq "File::Spec::VMS->catdir('','-','d2','d3')" ) {
+ $expected = '-/d2/d3'
+ }
+ elsif ($function eq "File::Spec::VMS->catdir('','-','','d3')" ) {
+ $expected = '-/d3'
+ }
+ elsif ($function eq
"File::Spec::VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')" ) {
+ $expected = 'file.'
+ }
}
ok $got, $expected, $function;
--- lib/File/Spec/t/crossplatform.t_5_8_6 Tue May 31 10:27:34 2005
+++ lib/File/Spec/t/crossplatform.t Wed Jun 1 14:26:23 2005
@@ -24,6 +24,24 @@
VMS => 'w',
);
+my $unix_report;
+my $unix_only;
+if ($^O eq 'VMS') {
+ $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'};
+ if (defined $unix_report) {
+ if (($unix_report lt '1') && ($unix_report ne 'ENABLE')) {
+ $unix_report = undef;
+ }
+ }
+ $unix_only = $ENV{'DECC$FILENAME_UNIX_ONLY'};
+ if (defined $unix_only) {
+ if (($unix_only lt '1') && ($unix_only ne 'ENABLE')) {
+ $unix_only = undef;
+ }
+ }
+ $unix_report = 1 if (defined $unix_only);
+}
+
ok 1, "Loaded";
foreach my $platform (@platforms) {
@@ -58,7 +76,15 @@
# abs2rel('A:/foo/bar', 'A:/foo') -> 'bar'
$file = $module->catpath($v, $module->catdir($module->rootdir, 'foo',
'bar'), 'file');
$base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
+ if (($^O eq 'VMS') && ($v eq 'v') && defined($unix_report)) {
+ # In VMS UNIX emulation, '/foo/bar' = 'foo:[bar]' unless there is
+ # actually a /foo directory under root, so results are different.
+ # Assume no /foo directory here so this result is expected.
+ $result = '[bar]file';
+ }
+ else {
$result = $module->catfile('bar', 'file');
+ }
is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file,
$base)";
# abs2rel('A:/foo/bar', 'B:/foo') -> 'A:/foo/bar'
