More \X fixing.

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

diff --git a/t/op/stat.t b/t/op/stat.t
index 983b54d..57460fc 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -11,6 +11,8 @@ use File::Spec;
 
 plan tests => 69;
 
+my $Perl = which_perl;
+
 $Is_Amiga   = $^O eq 'amigaos';
 $Is_Cygwin  = $^O eq 'cygwin';
 $Is_Dos     = $^O eq 'dos';
@@ -34,13 +36,17 @@ 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];
-is($nlink, 1, 'nlink on regular file');
+SKIP: {
+    skip "No link count", 1 if $Is_VMS;
+
+    is($nlink, 1, 'nlink on regular file');
+}
 
 SKIP: {
   skip "mtime and ctime not reliable", 2 
@@ -74,6 +80,9 @@ SKIP: {
 
     SKIP: {
         skip "No link count", 1 if $Config{dont_use_nlink};
+        skip "Cygwin9X fakes hard links by copying", 1
+          if $Config{myuname} =~ /^cygwin_(?:9\d|me)\b/i;
+
         is($nlink, 2,     'Link count on hard linked file' );
     }
 
@@ -100,13 +109,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;
 
@@ -187,8 +196,8 @@ ok(! -e $tmpfile_link,  '   -e on unlinked file');
 SKIP: {
     skip "No character, socket or block special files", 3
       if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
-    skip "/dev/ isn't available to test against", 3
-      unless -d '/dev/' && -r '/dev/' && -x '/dev/';
+    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";
@@ -196,33 +205,40 @@ SKIP: {
 
     skip "$CMD failed", 3 if $DEV eq '';
 
-    my $type;
-
-    my $skip = sub { ok(1, "Skip: no $_[0]s in /dev") };
-    my $ok   = sub { ok(1, "$_[0] /dev/$1") };
-    my $fail = sub { ok(0, "ls -l thinks /dev/$1 is $_[0] but $_[1] says not") };
-    
-    if ($DEV !~ /\nb.* (\S+)\n/) { $skip->("block special") }
-    elsif (-b "/dev/$1")         { $ok->  ("block special") }
-    else { $fail->("block special", "-b") }
-    
-    if ($DEV !~ /\nc.* (\S+)\n/) { $skip->("character special") }
-    elsif (-c "/dev/$1")         { $ok->  ("character special") }
-    else { $fail->("character special", "-c") }
-    
-    if ($DEV !~ /\ns.* (\S+)\n/) { $skip->("socket") }
-    elsif (-S "/dev/$1")         { $ok->  ("socket") }
-    else { $fail->("socket", "-S") }
+    my @DEV = do { my $dev; opendir($dev, "/dev") ? readdir($dev) : () };
+
+    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].+?\sstdout$}{}m;
+    @DEV =  grep { $_ ne 'stdout' } @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 @c2 = eval qq[grep { $_[1] "/dev/\$_" } \@DEV];
+       my $c1 = scalar @c1;
+       my $c2 = scalar @c2;
+       is($c1, $c2, "ls and $_[1] agreeing on /dev ($c1 $c2)");
+    };
+
+    $try->('b', '-b');
+    $try->('c', '-c');
+    $try->('s', '-S');
 }
 
+ok(! -b $Curdir,    '!-b cwd');
 ok(! -c $Curdir,    '!-c cwd');
 ok(! -S $Curdir,    '!-S cwd');
-ok(! -b $Curdir,    '!-b cwd');
-
 
 SKIP: {
-    skip "No setuid", 3 if $Is_MPE or $Is_Amiga or $Is_Dosish or $Is_Cygwin;
-
     my($cnt, $uid);
     $cnt = $uid = 0;
 
@@ -242,17 +258,11 @@ SKIP: {
     }
     closedir BIN;
 
-    if( !isnt($cnt, 0,    'found some programs') ||
-        !isnt($uid, 0,    'found some setuid programs') ||
-        !ok($uid < $cnt,  "  they're not all setuid") )
-    {
-        print <<DIAG;
-# The above two tests assume that at least one of these directories
-# are readable, executable and contain at least one setuid file
-# (but aren't all setuid).
-#   @bin
-DIAG
-    }
+    skip "No setuid programs", 3 if $uid == 0;
+
+    isnt($cnt, 0,    'found some programs');
+    isnt($uid, 0,    '  found some setuid programs');
+    ok($uid < $cnt,  "    they're not all setuid");
 }
 
 
@@ -275,14 +285,18 @@ SKIP: {
         close(TTY);
     }
     ok(! -t TTY,    '!-t on closed TTY filehandle');
-    ok(-t,          '-t on STDIN');
+
+    {
+        local $TODO = 'STDIN not a tty when output is to pipe' if $Is_VMS;
+        ok(-t,          '-t on STDIN');
+    }
 }
 
 my $Null = File::Spec->devnull;
 SKIP: {
     skip "No null device to test with", 1 unless -e $Null;
 
-    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);
 }
@@ -293,8 +307,8 @@ SKIP: {
 ok(-T 'op/stat.t',      '-T');
 ok(! -B 'op/stat.t',    '!-B');
 
-ok(-B $^X,      '-B');
-ok(! -T $^X,    '!-T');
+ok(-B $Perl,      '-B');
+ok(! -T $Perl,    '!-T');
 
 open(FOO,'op/stat.t');
 SKIP: {