Re: [PATCH] chom?p needs to remove read only fakery

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

diff --git a/t/op/stat.t b/t/op/stat.t
index 3d4a95b..b99734b 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -9,7 +9,9 @@ BEGIN {
 use Config;
 use File::Spec;
 
-plan tests => 73;
+plan tests => 69;
+
+my $Perl = which_perl;
 
 $Is_Amiga   = $^O eq 'amigaos';
 $Is_Cygwin  = $^O eq 'cygwin';
@@ -40,7 +42,11 @@ close FOO;
 open(FOO, ">$tmpfile") || BAILOUT("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 
@@ -185,35 +191,43 @@ unlink($tmpfile_link);
 ok(! -e $tmpfile_link,  '   -e on unlinked file');
 
 SKIP: {
-    skip "No character, socket or block special files", 7
+    skip "No character, socket or block special files", 3
       if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
-    skip "/dev/ isn't available to test against", 7
-      unless -d '/dev/' && -r '/dev/' && -x '/dev/';
-
-    opendir DEV, "/dev/" or BAILOUT("Can't open /dev/: $!");
-    my($cnt, $char, $sock, $block);
-    $cnt = $char = $sock = $block = 0;
-    foreach (readdir DEV) {
-        my $file = "/dev/$_";
-        $cnt++;
-        $char++  if -c $file;
-        $sock++  if -S $file;
-        $block++ if -b $file;
-    }
+    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 $DEV = qx($CMD);
+
+    skip "$CMD failed", 3 if $DEV eq '';
 
-    isnt( $cnt,   0,  'Found some files in /dev/ to test against' );
-    isnt( $char,  0,  '    and some character special files' );
-    isnt( $sock,  0,  '    and some socket files' );
-    isnt( $block, 0,  '    and some block special files' );
-    ok( $char  < $cnt,   "   they're not all character special" );
-    ok( $sock  < $cnt,   "   they're not all sockets" );
-    ok( $block < $cnt,   "   they're not all block special" );
+    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].+?\bstdout$}{}m;
+    @DEV = grep { ! m{\bstdout$} } @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;
@@ -288,8 +302,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: {