diff_os2_tests_72 - metacpan.org

This patch cleans up the 4 files of the tests suite which are known to
fail on OS/2 by the reasons not related to perl.

It also adds "skipped" explanations for all these tests.

Enjoy,
Ilya

--- ./t/io/fs.t~	Tue Jan 27 11:17:40 1998
+++ ./t/io/fs.t	Fri Jul 17 23:13:10 1998
@@ -9,7 +9,7 @@ BEGIN {
 
 use Config;
 
-$Is_Dos=$^O eq 'dos';
+$Is_Dosish = ($^O eq 'dos' or $^O eq 'os2');
 
 # avoid win32 (for now)
 do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32';
@@ -32,35 +32,56 @@ close(fh);
 open(fh,'>a') || die "Can't create a";
 close(fh);
 
-if (eval {link('a','b')} || $Is_Dos) {print "ok 2\n";} else {print "not ok 2\n";}
-
-if (eval {link('b','c')} || $Is_Dos) {print "ok 3\n";} else {print "not ok 3\n";}
+if ($Is_Dosish) {print "ok 2 # skipped: no link\n";} 
+elsif (eval {link('a','b')}) {print "ok 2\n";} 
+else {print "not ok 2\n";}
+
+if ($Is_Dosish) {print "ok 3 # skipped: no link\n";} 
+elsif (eval {link('b','c')}) {print "ok 3\n";} 
+else {print "not ok 3\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
 
-if ($Config{dont_use_nlink} || $nlink == 3 || $Is_Dos)
-    {print "ok 4\n";} else {print "not ok 4\n";}
-
-if (($mode & 0777) == 0666 || $^O eq 'amigaos' || $Is_Dos)
-    {print "ok 5\n";} else {print "not ok 5\n";}
+if ($Config{dont_use_nlink} || $Is_Dosish)
+    {print "ok 4 # skipped: no link\n";} 
+elsif ($nlink == 3)
+    {print "ok 4\n";} 
+else {print "not ok 4\n";}
+
+if ($^O eq 'amigaos' || $Is_Dosish)
+    {print "ok 5 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0666)
+    {print "ok 5\n";} 
+else {print "not ok 5\n";}
 
 if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0777 || $Is_Dos) {print "ok 7\n";} else {print "not ok 7\n";}
-
-if ((chmod 0700,'c','x') == 2 || $Is_Dos) {print "ok 8\n";} else {print "not ok 8\n";}
+if ($Is_Dosish) {print "ok 7 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0777) {print "ok 7\n";} 
+else {print "not ok 7\n";}
+
+if ($Is_Dosish) {print "ok 8 # skipped: no link\n";} 
+elsif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} 
+else {print "not ok 8\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0700 || $Is_Dos) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($Is_Dosish) {print "ok 9 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0700) {print "ok 9\n";} 
+else {print "not ok 9\n";}
+
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('x');
-if (($mode & 0777) == 0700 || $Is_Dos) {print "ok 10\n";} else {print "not ok 10\n";}
-
-if ((unlink 'b','x') == 2 || $Is_Dos) {print "ok 11\n";} else {print "not ok 11\n";}
+if ($Is_Dosish) {print "ok 10 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0700) {print "ok 10\n";} 
+else {print "not ok 10\n";}
+
+if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; } 
+elsif ((unlink 'b','x') == 2) {print "ok 11\n";} 
+else {print "not ok 11\n";}
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('b');
 if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
@@ -72,13 +93,15 @@ if (rename('a','b')) {print "ok 14\n";} 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('a');
 if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
-$foo = (utime 500000000,500000001,'b');
+$delta = $Is_Dosish ? 2 : 1;	# Granularity of time on the filesystem
+$foo = (utime 500000000,500000000 + $delta,'b');
 if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('b');
 if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
-if (($atime == 500000000 && $mtime == 500000001)
-	|| $wd =~ m#/afs/# || $^O eq 'amigaos' || $Is_Dos)
+if ($wd =~ m#/afs/# || $^O eq 'amigaos')
+    {print "ok 18 # skipped: granularity of the filetime\n";}
+elsif ($atime == 500000000 && $mtime == 500000000 + $delta)
     {print "ok 18\n";}
 else
     {print "not ok 18 $atime $mtime\n";}
@@ -122,12 +145,12 @@ else {
   { select FH; $| = 1; select STDOUT }
   print FH "helloworld\n";
   truncate FH, 5;
-  if ($Is_Dos) {
+  if ($^O eq 'dos') {
       close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
   }
   if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"}
   truncate FH, 0;
-  if ($Is_Dos) {
+  if ($^O eq 'dos') {
       close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
   }
   if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"}
--- ./t/op/stat.t~	Sun Jul  5 00:33:10 1998
+++ ./t/op/stat.t	Fri Jul 17 22:45:34 1998
@@ -13,9 +13,10 @@ print "1..58\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_Dos = $^O eq 'dos';
+$Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32;
 chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
 
-$DEV = `ls -l /dev` unless ($Is_MSWin32 || $Is_Dos);
+$DEV = `ls -l /dev` unless $Is_Dosish;
 
 unlink "Op.stat.tmp";
 open(FOO, ">Op.stat.tmp");
@@ -34,7 +35,7 @@ close(FOO);
 
 sleep 2;
 
-if ($Is_MSWin32 || $Is_Dos) { unlink "Op.stat.tmp2" }
+if ($Is_Dosish) { unlink "Op.stat.tmp2" }
 else {
     `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
 }
@@ -42,15 +43,19 @@ else {
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('Op.stat.tmp');
 
-if ($Is_MSWin32 || $Is_Dos || $Config{dont_use_nlink} || $nlink == 2)
-    {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
+if ($Is_Dosish || $Config{dont_use_nlink})
+    {print "ok 3 # skipped: no link count\n";} 
+elsif ($nlink == 2)
+    {print "ok 3\n";} 
+else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
 
-if (   ($mtime && $mtime != $ctime)
-	|| $Is_MSWin32
-	|| $Is_Dos
+if (   $Is_Dosish
 	|| ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime) # Solaris tmpfs bug
 	|| $cwd =~ m#/afs/#
 	|| $^O eq 'amigaos') {
+    print "ok 4 # skipped: different semantic of mtime/ctime\n";
+}
+elsif (   ($mtime && $mtime != $ctime)  ) {
     print "ok 4\n";
 }
 else {
@@ -91,7 +96,9 @@ foreach ((12,13,14,15,16,17)) {
 chmod 0700,'Op.stat.tmp';
 if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
 if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
-if ($Is_MSWin32 or $Is_Dos or -x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
+if ($Is_Dosish) {print "ok 20 # skipped: -x by extension\n";} 
+elsif (-x 'Op.stat.tmp') {print "ok 20\n";} 
+else {print "not ok 20\n";}
 
 if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
 if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
@@ -99,7 +106,7 @@ if (! -d 'Op.stat.tmp') {print "ok 22\n"
 if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
 if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
 
-if (!($Is_MSWin32 || $Is_Dos) and `ls -l perl` =~ /^l.*->/) {
+if (!$Is_Dosish and `ls -l perl` =~ /^l.*->/) {
     if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
 }
 else {
@@ -142,7 +149,9 @@ else
     {print "not ok 33\n";}
 if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
 
-if ($^O eq 'amigaos' or $Is_MSWin32 || $Is_Dos) {print "ok 35\n"; goto tty_test;}
+if ($^O eq 'amigaos' or $Is_Dosish) {
+  print "ok 35 # skipped: no -u\n"; goto tty_test;
+}
 
 $cnt = $uid = 0;
 
--- ./t/lib/io_pipe.t~	Tue Feb  3 14:58:12 1998
+++ ./t/lib/io_pipe.t	Fri Jul 17 23:06:30 1998
@@ -41,6 +41,12 @@ print $pipe "not ok 3\n" ;
 $pipe->close or print "# \$!=$!\nnot ";
 print "ok 4\n";
 
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and system "$^X -I../lib -Mopcode -e 'defined fork or die'  > /dev/null 2>&1"){
+  print "ok $_ # skipped: broken fork\n" for 5..10;
+  exit 0;
+}
+
 $pipe = new IO::Pipe;
 
 $pid = fork();
--- ./t/lib/io_sock.t~	Thu May 14 14:58:00 1998
+++ ./t/lib/io_sock.t	Fri Jul 17 23:05:06 1998
@@ -32,6 +32,12 @@ $listen = IO::Socket::INET->new(Listen =
 
 print "ok 1\n";
 
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and system "$^X -I../lib -Mopcode -e 'defined fork or die'  > /dev/null 2>&1"){
+  print "ok $_ # skipped: broken fork\n" for 2..5;
+  exit 0;
+}
+
 $port = $listen->sockport;
 
 if($pid = fork()) {
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)