In lib/File/Compare.t :
The tests with the filename having a trailing space was not working
correctly on VMS in the traditional mode, and was leaving one of the
temporary files behind.
With VMS in the Extended File System (EFS) character set mode, the test
fails because it requires two things:
1. VMS to be in UNIX file sharing modes.
This is default exclusive locking disabled.
2. flush() on file handles need to be implemented/fixed on VMS to work.
It also needs to have the temp directory as chosen by File::Temp to be
set to an ODS-5 volume.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/File/Compare.t Tue Jun 13 14:29:14 2006
+++ lib/File/Compare.t Mon Nov 24 19:24:36 2008
@@ -14,6 +14,28 @@
}
}
+my $vms_unix_rpt = 0;
+my $vms_efs = 0;
+my $vms_file_sharing = 0;
+my $vms_default_mode = 0;
+
+if ($^O eq 'VMS') {
+ $vms_default_mode = 1;
+ if (eval 'require VMS::Feature') {
+ $vms_unix_rpt = VMS::Feature::current('filename_unix_report');
+ $vms_efs = VMS::Feature::current('efs_charset');
+ $vms_file_sharing = VMS::Feature::current('file_sharing');
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ my $file_sharing = $ENV{'DECC$FILE_SHARING'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ $vms_file_sharing = $file_sharing =~ /^[ET1]/i;
+ }
+ $vms_default_mode = 0 if ($vms_efs && $vms_file_sharing);
+}
+
print "1..13\n";
use File::Compare qw(compare compare_text);
@@ -78,7 +100,16 @@
my $template = File::Spec->catfile(File::Spec->tmpdir, 'fcmpXXXX');
my($tfh,$filename) = mkstemp($template);
+
# NB. The trailing space is intentional (see [perl #37716])
+
+ # With the default VMS mode, the trailing space is stripped off
+ # silently. Which means we open a second version of the same filename.
+ # Which makes the code below appear to work until the extended character
+ # set becomes available. Then the two filenames are different, and
+ # this test attempts to open a file already open by the temp file handle.
+ # by default VMS does not allow this unless DECC$FILE_SHARING is set.
+
open my $tfhSP, ">", "$filename "
or die "Could not open '$filename ' for writing: $!";
binmode($tfhSP);
@@ -93,25 +124,62 @@
print $tfhSP $data;
close($tfhSP);
}
+
+ # X/Open requires this if you expect the data to actually be readable
+ # by other streams, but this only affects VMS.
+ if ($vms_file_sharing) {
+ $tfh->flush or die "Could not flush filehandle: $!";
+ }
+
seek($tfh,0,0);
$donetests[0] = compare($tfh, 'README');
$donetests[1] = compare($filename, 'README');
- unlink0($tfh,$filename);
+
+ # In VMS default mode, this unlink fails because it sees $filename.' '
+ # instead of $filename and it is not the file handled that is open.
+ # So we can not do this until after $filename.'' is unlinked.
+ unlink0($tfh,$filename) unless $vms_default_mode;
+
$donetests[2] = compare('README', "$filename ");
unlink "$filename ";
+
+ # In VMS default mode, clean this up now.
+ unlink0($tfh,$filename) if $vms_default_mode;
};
print "# problem '$@' when testing with a temporary file\n" if $@;
if (@donetests == 3) {
print "not " unless $donetests[0] == 0;
- print "ok 11 # fh/file [$donetests[0]]\n";
- print "not " unless $donetests[1] == 0;
- print "ok 12 # file/file [$donetests[1]]\n";
+ print "ok 11 # fh/file [$donetests[0]] \n";
+ unless ($donetests[1] == 0) {
+ if ($vms_file_sharing) {
+ $vms_todo_flush = " TODO - flush() not implmented on VMS; ";
+ } else {
+ print "# DECC\$FILE_SHARING needs to be enabled for test 12\n";
+ }
+ print "not ";
+ }
+ print "ok 12 # $vms_todo_flush file/file [$donetests[1]]\n";
print "not " unless $donetests[2] == 0;
print "ok 13 # ";
print "TODO" if $^O eq "cygwin"; # spaces after filename silently trunc'd
print " file/fileCR [$donetests[2]]\n";
}
else {
+ if ($^O eq 'VMS') {
+ if ($vms_efs) {
+ print "# DECC\$EFS_CHARSET mode enabled.\n";
+ if (!$vms_file_sharing) {
+ print "not ok 11 #Skip\nok 12 # Skip\nok 13 # Skip\n";
+ print "# DECC\$FILE_SHARING needs to be enabled for this
test.\n";
+ }
+ print "# Temporary directory may not be on an ODS-5 volume\n";
+
+ } else {
+ print "not ok 11\nok 12 # Skip\nok 13 # Skip\n";
+ print "# Could not create test file in temp directory.\n";
+ }
+ } else {
print "ok 11# Skip\nok 12 # Skip\nok 13 # Skip Likely due to File::Temp\n";
+ }
}
