Re: Making IO::Socket pass test on Win32

[p5sagit/p5-mst-13.2.git] / ext / IO / t / io_pipe.t

diff --git a/ext/IO/t/io_pipe.t b/ext/IO/t/io_pipe.t
index 7a45a7c..9b7d6f4 100755 (executable)
--- a/ext/IO/t/io_pipe.t
+++ b/ext/IO/t/io_pipe.t
@@ -20,8 +20,18 @@ BEGIN {
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
        $reason = 'IO extension unavailable';
     }
-    elsif (! $Config{'d_fork'}) {
-       $reason = 'no fork';
+    elsif (
+        ! eval {
+            my $pid= fork();
+            ! defined($pid) and die "Fork failed!";
+            ! $pid and exit;
+            defined waitpid($pid, 0);
+        }
+    ) {
+        $reason = "no fork: $@";
+    }
+    elsif ($^O eq 'MSWin32' && !$ENV{TEST_IO_PIPE}) {
+       $reason = 'Win32 testing environment not set';
     }
     if ($reason) {
        print "1..0 # Skip: $reason\n";
@@ -31,23 +41,27 @@ BEGIN {
 
 use IO::Pipe;
 
+my $is_win32=$^O eq 'MSWin32' ? "MSWin32 has broken pipes" : "";
 
 $| = 1;
 print "1..10\n";
 
-$pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"');
-while (<$pipe>) {
-  s/^not //;
-  print;
+if ($is_win32) {
+    print "ok $_ # skipped: $is_win32\n" for 1..4;
+} else {
+    $pipe = new IO::Pipe->reader($perl, '-e', 'print qq(not ok 1)\n"');
+    while (<$pipe>) {
+      s/^not //;
+      print;
+    }
+    $pipe->close or print "# \$!=$!\nnot ";
+    print "ok 2\n";
+    $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //';
+    $pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
+    print $pipe "not ok 3\n" ;
+    $pipe->close or print "# \$!=$!\nnot ";
+    print "ok 4\n";
 }
-$pipe->close or print "# \$!=$!\nnot ";
-print "ok 2\n";
-
-$cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //';
-$pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
-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
@@ -73,17 +87,20 @@ elsif(defined $pid)
   $pipe->reader;
   $stdin = bless \*STDIN, "IO::Handle";
   $stdin->fdopen($pipe,"r");
-  exec 'tr', 'YX', 'ko';
+  exec $^X, '-pne', 'tr/YX/ko/';
  }
 else
  {
   die "# error = $!";
  }
 
-$pipe = new IO::Pipe;
-$pid = fork();
+if ($is_win32) {
+    print "ok $_ # skipped: $is_win32\n" for 7..8;
+} else {
+    $pipe = new IO::Pipe;
+    $pid = fork();
 
-if($pid)
+    if($pid)
  {
   $pipe->reader;
   while(<$pipe>) {
@@ -93,7 +110,7 @@ if($pid)
   $pipe->close;
   wait;
  }
-elsif(defined $pid)
+    elsif(defined $pid)
  {
   $pipe->writer;
 
@@ -102,24 +119,27 @@ elsif(defined $pid)
   print STDOUT "not ok 7\n";
   exec 'echo', 'not ok 8';
  }
-else
+    else
  {
   die;
  }
+}
+if ($is_win32) {
+    print "ok $_ # skipped: $is_win32\n" for 9;
+} else {
+    $pipe = new IO::Pipe;
+    $pipe->writer;
 
-$pipe = new IO::Pipe;
-$pipe->writer;
-
-$SIG{'PIPE'} = 'broken_pipe';
+    $SIG{'PIPE'} = 'broken_pipe';
 
-sub broken_pipe {
+    sub broken_pipe {
     print "ok 9\n";
-}
-
-print $pipe "not ok 9\n";
-$pipe->close;
+    }
 
-sleep 1;
+    print $pipe "not ok 9\n";
+    $pipe->close;
 
+    sleep 1;
+}
 print "ok 10\n";