t/io/fs.t - skip all tests that fail on VOS
[p5sagit/p5-mst-13.2.git] / t / io / fs.t
index 7331cd4..9f168cb 100755 (executable)
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -39,7 +39,12 @@ my $needs_fh_reopen =
     # Not needed on HPFS, but needed on HPFS386 ?!
     || $^O eq 'os2';
 
-plan tests => 32;
+$needs_fh_reopen = 1 if (defined &Win32::IsWin95 && Win32::IsWin95());
+
+my $skip_mode_checks =
+    $^O eq 'cygwin' && $ENV{CYGWIN} !~ /ntsec/;
+
+plan tests => 36;
 
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
@@ -61,7 +66,7 @@ chdir './tmp';
 umask(022);
 
 SKIP: {
-    skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare');
+    skip "bogus umask", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare') ||  ($^O eq 'epoc'); 
 
     is((umask(0)&0777), 022, 'umask'),
 }
@@ -74,7 +79,7 @@ close(fh);
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks);
 
-SKIP: { 
+SKIP: {
     skip("no link", 4) unless $has_link;
 
     ok(link('a','b'), "link a b");
@@ -91,8 +96,13 @@ SKIP: {
 
     SKIP: {
         skip "hard links not that hard in $^O", 1 if $^O eq 'amigaos';
+       skip "no mode checks", 1 if $skip_mode_checks;
 
-        is($mode & 0777, 0666, "mode of triply-linked file");
+#      if ($^O eq 'cygwin') { # new files on cygwin get rwx instead of rw-
+#          is($mode & 0777, 0777, "mode of triply-linked file");
+#      } else {
+            is($mode & 0777, 0666, "mode of triply-linked file");
+#      }
     }
 }
 
@@ -106,23 +116,35 @@ SKIP: {
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
      $blksize,$blocks) = stat('c');
 
-    is($mode & 0777, $newmode, "chmod going through");
+    SKIP: {
+       skip "no mode checks", 1 if $skip_mode_checks;
+
+        is($mode & 0777, $newmode, "chmod going through");
+    }
 
     $newmode = 0700;
     chmod 0444, 'x';
     $newmode = 0666;
 
     is(chmod($newmode,'c','x'), 2, "chmod two files");
-    
+
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
      $blksize,$blocks) = stat('c');
 
-    is($mode & 0777, $newmode, "chmod going through to c");
+    SKIP: {
+       skip "no mode checks", 1 if $skip_mode_checks;
+
+        is($mode & 0777, $newmode, "chmod going through to c");
+    }
 
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
      $blksize,$blocks) = stat('x');
 
-    is($mode & 0777, $newmode, "chmod going through to x");
+    SKIP: {
+       skip "no mode checks", 1 if $skip_mode_checks;
+
+        is($mode & 0777, $newmode, "chmod going through to x");
+    }
 
     is(unlink('b','x'), 2, "unlink two files");
 
@@ -160,7 +182,7 @@ SKIP: {
 }
 
 SKIP: {
-    skip "filesystem atime/mtime granularity too low", 2 
+    skip "filesystem atime/mtime granularity too low", 2
       unless $accurate_timestamps;
 
     print "# atime - $atime  mtime - $mtime  delta - $delta\n";
@@ -176,21 +198,23 @@ SKIP: {
             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/mtime - accounted for possible NFS/glibc2.2 bug on linux");
-            } 
+                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 mtime - $atime/$new_atime $mtime/$new_mtime");
+                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");
@@ -214,7 +238,7 @@ chdir $wd || die "Can't cd back to $wd";
 SKIP: {
     skip "Win32/Netware specific test", 2
       unless ($^O eq 'MSWin32') || ($^O eq 'NetWare');
-    skip "No symbolic links found to test with", 2 
+    skip "No symbolic links found to test with", 2
       unless  `ls -l perl 2>nul` =~ /^l.*->/;
 
     system("cp TEST TEST$$");
@@ -237,9 +261,10 @@ close(IOFSCOM);
 # as per UNIX FAQ.
 
 SKIP: {
+# Check truncating a closed file.
     eval { truncate "Iofs.tmp", 5; };
-
-    skip("no truncate - $@", 4) if $@;
+    
+    skip("no truncate - $@", 10) if $@;
 
     is(-s "Iofs.tmp", 5, "truncation to five bytes");
 
@@ -247,7 +272,14 @@ SKIP: {
 
     ok(-z "Iofs.tmp",    "truncation to zero bytes");
 
+#these steps are necessary to check if file is really truncated
+#On Win95, FH is updated, but file properties aren't
     open(FH, ">Iofs.tmp") or die "Can't create Iofs.tmp";
+    print FH "x\n" x 200;
+    close FH;
+
+# Check truncating an open file.
+    open(FH, ">>Iofs.tmp") or die "Can't open Iofs.tmp for appending";
 
     binmode FH;
     select FH;
@@ -263,8 +295,12 @@ SKIP: {
     if ($needs_fh_reopen) {
        close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
     }
+       
+    if ($^O eq 'vos') {
+        skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 7);
+    }
 
-    is(-s "Iofs.tmp", 200, "fh resize to 200 working");
+    is(-s "Iofs.tmp", 200, "fh resize to 200 working (filename check)");
 
     ok(truncate(FH, 0), "fh resize to zero");
 
@@ -272,7 +308,13 @@ SKIP: {
        close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
     }
 
-    ok(-z "Iofs.tmp", "fh resize to zero working");
+    ok(-z "Iofs.tmp", "fh resize to zero working (filename check)");
+
+    ok(truncate(FH, 200), "fh resize to 200");
+    is(-s FH, 200, "fh resize to 200 working (FH check)");
+
+    ok(truncate(FH, 0), "fh resize to 0");
+    ok(-z FH, "fh resize to 0 working (FH check)");
 
     close FH;
 }
@@ -286,7 +328,7 @@ SKIP: {
     open(fh,'>x') || die "Can't create x";
     close(fh);
     rename('x', 'X');
-    
+
     # this works on win32 only, because fs isn't casesensitive
     ok(-e 'X', "rename working");