This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Alternate backup file rename test for VMS.
authorCraig A. Berry <craigberry@mac.com>
Fri, 5 Jan 2018 19:54:35 +0000 (13:54 -0600)
committerCraig A. Berry <craigberry@mac.com>
Fri, 5 Jan 2018 19:54:35 +0000 (13:54 -0600)
The existing test that made a directory called foo.bak and then
made sure the rename of a backup file from in-place edit failed
to overwrite the directory doesn't work on VMS because there is
no conflict between a file named foo.bak and directory named
[foo^.bak] in directory syntax or foo^.bak.DIR in filename syntax.
The .DIR extension is always there, and other dots in the name
are escaped with caret because dot is the directory delimiter.

So just make version 32767 of foo.bak and when the rename tries
to make the next higher version it will fail.  We're testing what
happens when the rename fails not why it fails, so we accomplish
the same goal via a different mechanism.

t/run/switches.t

index 1b1f596..7ccef1e 100644 (file)
@@ -546,8 +546,16 @@ CODE
 
     {
         # test we handle the rename to the backup failing
 
     {
         # test we handle the rename to the backup failing
-        # make it fail by creating a directory of the backup name
-        mkdir "$work.bak" or die "Cannot make mask backup directory: $!";
+        if ($^O eq 'VMS') {
+            # make it fail by creating a .bak file with a version than which no higher can be created
+            # can't make a directory because foo.bak and foo^.bak.DIR do not conflict.
+            open my $fh, '>', "$work.bak;32767" or die "Cannot make mask backup file: $!";
+            close $fh or die "Failed to close: $!";
+        }
+        else {
+            # make it fail by creating a directory of the backup name
+            mkdir "$work.bak" or die "Cannot make mask backup directory: $!";
+        }
         fresh_perl_like(<<'CODE', qr/Can't rename/, { stderr => 1 }, "fail backup rename");
 @ARGV = ("tmpinplace/foo");
 $^I = ".bak";
         fresh_perl_like(<<'CODE', qr/Can't rename/, { stderr => 1 }, "fail backup rename");
 @ARGV = ("tmpinplace/foo");
 $^I = ".bak";
@@ -556,7 +564,12 @@ while (<>) {
 }
 print "ok\n";
 CODE
 }
 print "ok\n";
 CODE
-        rmdir "$work.bak" or die "Cannot remove mask backup directory: $!";
+        if ($^O eq 'VMS') {
+            1 while unlink "$work.bak";
+        }
+        else {
+            rmdir "$work.bak" or die "Cannot remove mask backup directory: $!";
+        }
     }
 
     {
     }
 
     {
@@ -575,7 +588,7 @@ CODE
     # we now use temp files for in-place editing, make sure we didn't leave
     # any behind in the above test
     opendir my $d, "tmpinplace" or die "Cannot opendir tmpinplace: $!";
     # we now use temp files for in-place editing, make sure we didn't leave
     # any behind in the above test
     opendir my $d, "tmpinplace" or die "Cannot opendir tmpinplace: $!";
-    my @names = grep !/^\.\.?$/ && $_ ne 'foo', readdir $d;
+    my @names = grep !/^\.\.?$/ && $_ ne 'foo' && $_ ne 'foo.', readdir $d;
     closedir $d;
     is(scalar(@names), 0, "no extra files")
       or diag "Found @names, expected none";
     closedir $d;
     is(scalar(@names), 0, "no extra files")
       or diag "Found @names, expected none";