Integrate mainline

[p5sagit/p5-mst-13.2.git] / t / op / stat.t

diff --git a/t/op/stat.t b/t/op/stat.t
index a78670a..c3bbe83 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
+    require './test.pl';       # for which_perl() etc
 }
 
 use Config;
@@ -11,7 +11,7 @@ use File::Spec;
 
 plan tests => 69;
 
-my $Perl = which_perl;
+my $Perl = which_perl();
 
 $Is_Amiga   = $^O eq 'amigaos';
 $Is_Cygwin  = $^O eq 'cygwin';
@@ -36,10 +36,10 @@ my $tmpfile_link = $tmpfile.'2';
 
 
 unlink $tmpfile;
-open(FOO, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
 close FOO;
 
-open(FOO, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
 
 my($nlink, $mtime, $ctime) = (stat(FOO))[$NLINK, $MTIME, $CTIME];
 SKIP: {
@@ -49,7 +49,7 @@ SKIP: {
 }
 
 SKIP: {
-  skip "mtime and ctime not reliable", 2 
+  skip "mtime and ctime not reliable", 2
     if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos;
 
   ok( $mtime,           'mtime' );
@@ -88,19 +88,23 @@ SKIP: {
 
     SKIP: {
         my $cwd = File::Spec->rel2abs($Curdir);
-        skip "Solaris tmpfs has different mtime/ctime link semantics", 2 
-                                     if $Is_Solaris and $cwd =~ m#^/tmp# and 
+        skip "Solaris tmpfs has different mtime/ctime link semantics", 2
+                                     if $Is_Solaris and $cwd =~ m#^/tmp# and
                                         $mtime && $mtime == $ctime;
         skip "AFS has different mtime/ctime link semantics", 2
                                      if $cwd =~ m#$Config{'afsroot'}/#;
         skip "AmigaOS has different mtime/ctime link semantics", 2
                                      if $Is_Amiga;
-
+        # Win32 could pass $mtime test but as FAT and NTFS have
+        # no ctime concept $ctime is ALWAYS == $mtime
+        # expect netware to be the same ...
+        skip "No ctime concept on this OS", 2
+                                     if $Is_MSWin32;
         if( !ok($mtime, 'hard link mtime') ||
             !isnt($mtime, $ctime, 'hard link ctime != mtime') ) {
             print <<DIAG;
-# Check if you are on a tmpfs of some sort.  Building in /tmp sometimes 
-# has this problem.  Also building on the ClearCase VOBS filesystem may 
+# Check if you are on a tmpfs of some sort.  Building in /tmp sometimes
+# has this problem.  Also building on the ClearCase VOBS filesystem may
 # cause this failure.
 DIAG
         }
@@ -109,13 +113,13 @@ DIAG
 }
 
 # truncate and touch $tmpfile.
-open(F, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(F, ">$tmpfile") || DIE("Can't open temp test file: $!");
 close F;
 
 ok(-z $tmpfile,     '-z on empty file');
 ok(! -s $tmpfile,   '   and -s');
 
-open(F, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(F, ">$tmpfile") || DIE("Can't open temp test file: $!");
 print F "hi\n";
 close F;
 
@@ -133,7 +137,7 @@ SKIP: {
         # Going to try to switch away from root.  Might not work.
         my $olduid = $>;
         eval { $> = 1; };
-        skip "Can't test -r or -w meaningfully if you're superuser", 2 
+        skip "Can't test -r or -w meaningfully if you're superuser", 2
           if $> == 0;
 
         SKIP: {
@@ -199,8 +203,8 @@ SKIP: {
     skip "/dev isn't available to test against", 3
       unless -d '/dev' && -r '/dev' && -x '/dev';
 
-    my $LS  = $Config{d_readlink} ? "ls -lL" : "ls -l"; 
-    my $CMD = "$LS /dev";
+    my $LS  = $Config{d_readlink} ? "ls -lL" : "ls -l";
+    my $CMD = "$LS /dev 2>/dev/null";
     my $DEV = qx($CMD);
 
     skip "$CMD failed", 3 if $DEV eq '';
@@ -210,13 +214,27 @@ SKIP: {
     skip "opendir failed: $!", 3 if @DEV == 0;
 
     # /dev/stdout might be either character special or a named pipe,
-    # depending on which OS and how are you running the test, so let's
-    # censor that one away.
-    $DEV =~ s{^[cp].+?\bstdout$}{}m;
-    @DEV = grep { ! m{\bstdout$} } @DEV;
+    # or a symlink, or a socket, depending on which OS and how are
+    # you running the test, so let's censor that one away.
+    # Similar remarks hold for stderr.
+    $DEV =~ s{^[cpls].+?\sstdout$}{}m;
+    @DEV =  grep { $_ ne 'stdout' } @DEV;
+    $DEV =~ s{^[cpls].+?\sstderr$}{}m;
+    @DEV =  grep { $_ ne 'stderr' } @DEV;
+
+    # /dev/printer is also naughty: in IRIX it shows up as
+    # Srwx-----, not srwx------.
+    $DEV =~ s{^.+?\sprinter$}{}m;
+    @DEV =  grep { $_ ne 'printer' } @DEV;
+
+    # If running as root, we will see .files in the ls result,
+    # and readdir() will see them always.  Potential for conflict,
+    # so let's weed them out.
+    $DEV =~ s{^.+?\s\..+?$}{}m;
+    @DEV =  grep { ! m{^\..+$} } @DEV;
 
     my $try = sub {
-       my @c1 = eval qq[\$DEV =~ /^$_[0]/mg];
+       my @c1 = eval qq[\$DEV =~ /^$_[0].*/mg];
        my @c2 = eval qq[grep { $_[1] "/dev/\$_" } \@DEV];
        my $c1 = scalar @c1;
        my $c2 = scalar @c2;
@@ -272,7 +290,7 @@ SKIP: {
         skip "Test uses unixisms", 2 if $Is_MSWin32 || $Is_NetWare;
         skip "No TTY to test -t with", 2 unless -e $TTY;
 
-        open(TTY, $TTY) || 
+        open(TTY, $TTY) ||
           warn "Can't open $TTY--run t/TEST outside of make.\n";
         ok(-t TTY,  '-t');
         ok(-c TTY,  'tty is -c');
@@ -289,8 +307,9 @@ SKIP: {
 my $Null = File::Spec->devnull;
 SKIP: {
     skip "No null device to test with", 1 unless -e $Null;
+    skip "We know Win32 thinks '$Null' is a TTY", 1 if $Is_MSWin32;
 
-    open(NULL, $Null) or BAIL_OUT("Can't open $Null: $!");
+    open(NULL, $Null) or DIE("Can't open $Null: $!");
     ok(! -t NULL,   'null device is not a TTY');
     close(NULL);
 }
@@ -357,4 +376,3 @@ unlink $tmpfile or print "# unlink failed: $!\n";
 # bug id 20011101.069
 my @r = \stat(".");
 is(scalar @r, 13,   'stat returns full 13 elements');
-