X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fio%2Ffs.t;h=b897647106764d0a5f05d3483a638f2f9659bb41;hb=ac27d13b824657b726428f3a6a1d5b3a01df569e;hp=4dd188e974a99db438e929186d33989de8439d63;hpb=e96b369dc61077fe31b75895167f55dbce4d7519;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/io/fs.t b/t/io/fs.t
index 4dd188e..b897647 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -14,9 +14,11 @@ my $Is_VMSish = ($^O eq 'VMS');
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
     $wd = `cd`;
-} elsif ($^O eq 'VMS') {
+}
+elsif ($^O eq 'VMS') {
     $wd = `show default`;
-} else {
+}
+else {
     $wd = `pwd`;
 }
 chomp($wd);
@@ -47,7 +49,7 @@ $needs_fh_reopen = 1 if (defined &Win32::IsWin95 && Win32::IsWin95());
 my $skip_mode_checks =
     $^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/;
 
-plan tests => 49;
+plan tests => 51;
 
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
@@ -56,6 +58,7 @@ if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
 }
 elsif ($^O eq 'VMS') {
     `if f\$search("[.tmp]*.*") .nes. "" then delete/nolog/noconfirm [.tmp]*.*.*`;
+    `if f\$search("tmp.dir") .nes. "" then set file/prot=o:rwed tmp.dir;`;
     `if f\$search("tmp.dir") .nes. "" then delete/nolog/noconfirm tmp.dir;`;
     `create/directory [.tmp]`;
 }
@@ -78,10 +81,10 @@ SKIP: {
     is((umask(0)&0777), 022, 'umask'),
 }
 
-open(fh,'>x') || die "Can't create x";
-close(fh);
-open(fh,'>a') || die "Can't create a";
-close(fh);
+open(FH,'>x') || die "Can't create x";
+close(FH);
+open(FH,'>a') || die "Can't create a";
+close(FH);
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks);
@@ -171,10 +174,16 @@ SKIP: {
     ok(open(my $fh, "<", "a"), "open a");
     is(chmod(0, $fh), 1, "fchmod");
     $mode = (stat "a")[2];
-    is($mode & 0777, 0, "perm reset");
+    SKIP: {
+        skip "no mode checks", 1 if $skip_mode_checks;
+        is($mode & 0777, 0, "perm reset");
+    }
     is(chmod($newmode, "a"), 1, "fchmod");
     $mode = (stat $fh)[2];
-    is($mode & 0777, $newmode, "perm restored");
+    SKIP: { 
+        skip "no mode checks", 1 if $skip_mode_checks;
+        is($mode & 0777, $newmode, "perm restored");
+    }
 }
 
 SKIP: {
@@ -194,7 +203,7 @@ SKIP: {
     skip "has fchown", 1 if ($Config{d_fchown} || "") eq "define";
     open(my $fh, "<", "a");
     eval { chown(0, 0, $fh); };
-    like($@, qr/^The fchown function is unimplemented at/, "fchown is unimplemented");
+    like($@, qr/^The f?chown function is unimplemented at/, "fchown is unimplemented");
 }
 
 is(rename('a','b'), 1, "rename a b");
@@ -227,56 +236,58 @@ SKIP: {
 
 
 sub check_utime_result {
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-    $blksize,$blocks) = stat('b');
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+     $blksize,$blocks) = stat('b');
 
-SKIP: {
-    skip "bogus inode num", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare');
+ SKIP: {
+	skip "bogus inode num", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare');
 
-    ok($ino,    'non-zero inode num');
-}
+	ok($ino,    'non-zero inode num');
+    }
 
-SKIP: {
-    skip "filesystem atime/mtime granularity too low", 2
-      unless $accurate_timestamps;
+ SKIP: {
+	skip "filesystem atime/mtime granularity too low", 2
+	    unless $accurate_timestamps;
 
-    print "# atime - $atime  mtime - $mtime  delta - $delta\n";
-    if($atime == 500000000 && $mtime == 500000000 + $delta) {
-        pass('atime');
-        pass('mtime');
-    }
-    else {
-        if ($^O =~ /\blinux\b/i) {
-            print "# Maybe stat() cannot get the correct atime, ".
-                  "as happens via NFS on linux?\n";
-            $foo = (utime 400000000,500000000 + 2*$delta,'b');
-            my ($new_atime, $new_mtime) = (stat('b'))[8,9];
-            print "# newatime - $new_atime  nemtime - $new_mtime\n";
-            if ($new_atime == $atime && $new_mtime - $mtime == $delta) {
-                pass("atime - accounted for possible NFS/glibc2.2 bug on linux");
-                pass("mtime - accounted for possible NFS/glibc2.2 bug on linux");
-            }
-            else {
-                fail("atime - $atime/$new_atime $mtime/$new_mtime");
-                fail("mtime - $atime/$new_atime $mtime/$new_mtime");
-            }
-        }
-        elsif ($^O eq 'VMS') {
-            # why is this 1 second off?
-            is( $atime, 500000001,          'atime' );
-            is( $mtime, 500000000 + $delta, 'mtime' );
-        }
-        elsif ($^O eq 'beos') {
-            SKIP: { skip "atime not updated", 1; }
-            is($mtime, 500000001, 'mtime');
-        }
-        else {
-            fail("atime");
-            fail("mtime");
-        }
+	print "# atime - $atime  mtime - $mtime  delta - $delta\n";
+	if($atime == 500000000 && $mtime == 500000000 + $delta) {
+	    pass('atime');
+	    pass('mtime');
+	}
+	else {
+	    if ($^O =~ /\blinux\b/i) {
+		print "# Maybe stat() cannot get the correct atime, ".
+		    "as happens via NFS on linux?\n";
+		$foo = (utime 400000000,500000000 + 2*$delta,'b');
+		my ($new_atime, $new_mtime) = (stat('b'))[8,9];
+		print "# newatime - $new_atime  nemtime - $new_mtime\n";
+		if ($new_atime == $atime && $new_mtime - $mtime == $delta) {
+		    pass("atime - accounted for possible NFS/glibc2.2 bug on linux");
+		    pass("mtime - accounted for possible NFS/glibc2.2 bug on linux");
+		}
+		else {
+		    fail("atime - $atime/$new_atime $mtime/$new_mtime");
+		    fail("mtime - $atime/$new_atime $mtime/$new_mtime");
+		}
+	    }
+	    elsif ($^O eq 'VMS') {
+		# why is this 1 second off?
+		is( $atime, 500000001,          'atime' );
+		is( $mtime, 500000000 + $delta, 'mtime' );
+	    }
+	    elsif ($^O eq 'beos') {
+            SKIP: {
+		    skip "atime not updated", 1;
+		}
+		is($mtime, 500000001, 'mtime');
+	    }
+	    else {
+		fail("atime");
+		fail("mtime");
+	    }
+	}
     }
 }
-}
 
 SKIP: {
     skip "has futimes", 1 if ($Config{d_futimes} || "") eq "define";
@@ -402,11 +413,11 @@ SKIP: {
 # check if rename() can be used to just change case of filename
 SKIP: {
     skip "Works in Cygwin only if check_case is set to relaxed", 1
-      if $^O eq 'cygwin';
+      if ($ENV{'CYGWIN'} && ($ENV{'CYGWIN'} =~ /check_case:(?:adjust|strict)/));
 
     chdir './tmp';
-    open(fh,'>x') || die "Can't create x";
-    close(fh);
+    open(FH,'>x') || die "Can't create x";
+    close(FH);
     rename('x', 'X');
 
     # this works on win32 only, because fs isn't casesensitive
@@ -422,11 +433,23 @@ if ($^O eq 'VMS') {
     `set file tmp.dir/protection=o:d`;
     ok(rename('tmp.dir', 'tmp1.dir'), "rename on directories") ||
       print "# errno: $!\n";
-} else {
+}
+else {
     ok(rename('tmp', 'tmp1'), "rename on directories");
 }
 
 ok(-d 'tmp1', "rename on directories working");
 
+{
+    # Change 26011: Re: A surprising segfault
+    # to make sure only that these obfuscated sentences will not crash.
+
+    map chmod(+()), ('')x68;
+    ok(1, "extend sp in pp_chmod");
+
+    map chown(+()), ('')x68;
+    ok(1, "extend sp in pp_chown");
+}
+
 # need to remove 'tmp' if rename() in test 28 failed!
 END { rmdir 'tmp1'; rmdir 'tmp'; 1 while unlink "Iofs.tmp"; }