Pack Patch (was Re: 5.002 - pack/unpack does not do "I" right)

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

diff --git a/t/op/stat.t b/t/op/stat.t
old mode 100644 (file)
new mode 100755 (executable)
index 8ba8e54..0ec3168
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -1,21 +1,26 @@
 #!./perl
 
-# $Header: stat.t,v 4.0 91/03/20 01:54:55 lwall Locked $
-
+# $RCSfile: stat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:28 $
+# 950521 DFD    This version hacked to make test 39 succeed on MachTen
+#               though the O.S. wrongly thinks /dev/null is a terminal
 print "1..56\n";
 
 chop($cwd = `pwd`);
 
+$DEV = `ls -l /dev`;
+
 unlink "Op.stat.tmp";
-open(foo, ">Op.stat.tmp");
+open(FOO, ">Op.stat.tmp");
+
+$junk = `ls Op.stat.tmp`;      # hack to make Apollo update link count
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-    $blksize,$blocks) = stat(foo);
+    $blksize,$blocks) = stat(FOO);
 if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
 if ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
 
-print foo "Now is the time for all good men to come to.\n";
-close(foo);
+print FOO "Now is the time for all good men to come to.\n";
+close(FOO);
 
 sleep 2;
 
@@ -30,10 +35,13 @@ if (($mtime && $mtime != $ctime) || $cwd =~ m#/afs/#) {
 }
 else {
     print "not ok 4\n";
+    print '#4 If test op/stat.t fails test 4, check if you are on a tmpfs';
+    print '#4 of some sort.  Building in /tmp sometimes has this problem.';
 }
 print "#4      :$mtime: != :$ctime:\n";
 
-`cp /dev/null Op.stat.tmp`;
+`rm -f Op.stat.tmp`;
+`touch Op.stat.tmp`;
 
 if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
 if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
@@ -81,16 +89,25 @@ if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
 `rm -f Op.stat.tmp Op.stat.tmp2`;
 if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
 
-if (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";}
+if ($DEV !~ /\nc.* (\S+)\n/)
+    {print "ok 29\n";}
+elsif (-c "/dev/$1")
+    {print "ok 29\n";}
+else
+    {print "not ok 29\n";}
 if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
 
-if (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer')
+if ($DEV !~ /\ns.* (\S+)\n/)
+    {print "ok 31\n";}
+elsif (-S "/dev/$1")
     {print "ok 31\n";}
 else
     {print "not ok 31\n";}
 if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
 
-if (! -e '/dev/mt0' || -b '/dev/mt0')
+if ($DEV !~ /\nb.* (\S+)\n/)
+    {print "ok 33\n";}
+elsif (-b "/dev/$1")
     {print "ok 33\n";}
 else
     {print "not ok 33\n";}
@@ -99,6 +116,7 @@ if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
 $cnt = $uid = 0;
 
 die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
+print ("not ok 35\n"), goto tty_test unless -d '/usr/bin';
 chdir '/usr/bin' || die "Can't cd to /usr/bin";
 while (defined($_ = <*>)) {
     $cnt++;
@@ -108,7 +126,12 @@ while (defined($_ = <*>)) {
 chdir $cwd || die "Can't cd back to $cwd";
 
 # I suppose this is going to fail somewhere...
-if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
+if ($uid > 0 && $uid < $cnt)
+    {print "ok 35\n";}
+else
+    {print "not ok 35 \n# ($uid $cnt)\n";}
+
+tty_test:
 
 unless (open(tty,"/dev/tty")) {
     print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
@@ -118,7 +141,8 @@ if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
 close(tty);
 if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
 open(null,"/dev/null");
-if (! -t null || -e '/xenix') {print "ok 39\n";} else {print "not ok 39\n";}
+if (! -t null || -e '/xenix' || -e '/MachTen')
+       {print "ok 39\n";} else {print "not ok 39\n";}
 close(null);
 if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
 
@@ -127,27 +151,36 @@ if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
 if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
 if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
 
-if (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";}
-if (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";}
-
-open(foo,'op/stat.t');
-if (-T foo) {print "ok 45\n";} else {print "not ok 45\n";}
-if (! -B foo) {print "ok 46\n";} else {print "not ok 46\n";}
-$_ = <foo>;
-if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
-if (-T foo) {print "ok 48\n";} else {print "not ok 48\n";}
-if (! -B foo) {print "ok 49\n";} else {print "not ok 49\n";}
-close(foo);
-
-open(foo,'op/stat.t');
-$_ = <foo>;
-if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
-if (-T foo) {print "ok 51\n";} else {print "not ok 51\n";}
-if (! -B foo) {print "ok 52\n";} else {print "not ok 52\n";}
-seek(foo,0,0);
-if (-T foo) {print "ok 53\n";} else {print "not ok 53\n";}
-if (! -B foo) {print "ok 54\n";} else {print "not ok 54\n";}
-close(foo);
+if (-B './perl' || -B './perl.exe') {print "ok 43\n";} else {print "not ok 43\n";}
+if (! -T './perl' && ! -T './perl.exe') {print "ok 44\n";} else {print "not ok 44\n";}
+
+open(FOO,'op/stat.t');
+eval { -T FOO; };
+if ($@ =~ /not implemented/) {
+    print "# $@";
+    for (45 .. 54) {
+       print "ok $_\n";
+    }
+}
+else {
+    if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";}
+    if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";}
+    $_ = <FOO>;
+    if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
+    if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";}
+    if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";}
+    close(FOO);
+
+    open(FOO,'op/stat.t');
+    $_ = <FOO>;
+    if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
+    if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";}
+    if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";}
+    seek(FOO,0,0);
+    if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";}
+    if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";}
+}
+close(FOO);
 
 if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
 if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}