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.
[perl5.git] / t / run / switches.t
index c293c64..7ccef1e 100644 (file)
@@ -473,6 +473,9 @@ __EOF__
               && ($Config{d_dirfd} || $Config{d_dir_dd_fd})
               && $Config{d_linkat}
               && $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/;
+        my ($osvers) = ($Config{osvers} =~ /^(\d+(?:\.\d+)?)/);
+        skip "NetBSD 6 libc defines at functions, but they're incomplete", 3
+            if $^O eq "netbsd" && $osvers < 7;
         fresh_perl_is(<<'CODE', "ok\n", { },
 @ARGV = ("tmpinplace/foo");
 $^I = "";
@@ -537,14 +540,22 @@ print "ok\n";
 CODE
                       "fork while in-place editing");
         ok(open($fh, "<", $work), "open out file");
-        is(scalar <$fh>, "yy\n", "file successfully saved after chdir");
+        is(scalar <$fh>, "yy\n", "file successfully saved after fork");
         close $fh;
     }
 
     {
         # 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";
@@ -553,7 +564,12 @@ while (<>) {
 }
 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: $!";
+        }
     }
 
     {
@@ -572,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: $!";
-    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";
@@ -593,7 +609,7 @@ CODE
         chmod 0700, "tmpinplace" or die "Cannot make tmpinplace writable again: $!";
         skip "Cannot make tmpinplace read only", 1
           if $canwrite;
-        fresh_perl_like(<<'CODE', qr/Can't rename/, { stderr => 1 }, "fail final rename");
+        fresh_perl_like(<<'CODE', qr/failed to rename/, { stderr => 1 }, "fail final rename");
 @ARGV = ("tmpinplace/foo");
 $^I = "";
 while (<>) {
@@ -653,7 +669,7 @@ $r = runperl(
 is( $r, "Hello, world!\n", "-E ~~" );
 
 $r = runperl(
-    switches   => [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(!defined) { say q(Hello, world!)"}}']
+    switches   => [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}']
 );
 is( $r, "Hello, world!\n", "-E given" );