Resend, lib/file/compare.t patch for VMS.
"John E. Malmberg" <[email protected]>
| Newsgroups | gmane.comp.lang.perl.ports.vms,gmane.comp.lang.perl.perl5.porters |
|---|---|
| Message-ID | <[email protected]> |
The lib/file/compare.t test has never been correct for VMS, but the bugs where mostly hidden until testing on a ODS-5 volume with that allows filenames with more characters in them than VMS traditionally allows. This is known as EFS_CHARSET mode. This also exposes that the vmsify() routine in the traditional VMS mode is not matching how the C library in VMS internally implements the equivalent function. I am not sure that we want to change the vmsify() function traditional VMS mode behavior at this time. It also exposes that the flush() operation is a no-op on the VMS platform, which is something that needs to be fixed. This issue with flush() has shown up before, but the test was modified to not use that algorithm. The DECC$FILE_SHARING feature needs to be active for this test to work when the EFS_CHARSET mode is on. By default DECC$FILE_SHARING is off, and so far none of the other Perl tests need it enabled, even when in UNIX compatible mode. This patch fixes the lib/file/compare.t test to actually work the way it was intended to on VMS when VMS is in the traditional mode, and not leave extra files behind in SYS$SCRATCH: On VMS SYS$SCRATCH: by default behaves like a user private copy of /tmp on Unix. This patch also adds diagnostics so that explains what is wrong when VMS is run in the EFS_CHARSET mode. As DECC$FILE_SHARING is not normally active, it has a check to skip the tests that require it. The last e-mail from Craig that I saw about the initial submission where he was not sure about the extra diagnostics, but was going to look it over, and I did not see a response to my more detailed post about patch and why these diagnostics are needed. Regards, -John [email protected] Personal Opinion Only
lib_file_compare_t.gdiff
(text/plain, 4 KB)
--- /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";
+ }
}