ext/IO/t/io_pipe.t

   1 #!./perl
   2
   3 my $perl;
   4
   5 BEGIN {
   6     unless(grep /blib/, @INC) {
   7         $perl = './perl';
   8         chdir 't' if -d 't';
   9         @INC = '../lib';
  10     }
  11     else {
  12         $perl = $^X;
  13     }
  14 }
  15
  16 use Config;
  17
  18 BEGIN {
  19     my $reason;
  20     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
  21         $reason = 'IO extension unavailable';
  22     }
  23     elsif (
  24         ! eval {
  25             my $pid= fork();
  26             ! defined($pid) and die "Fork failed!";
  27             ! $pid and exit;
  28             defined waitpid($pid, 0);
  29         }
  30     ) {
  31         $reason = "no fork: $@";
  32     }
  33     elsif ($^O eq 'MSWin32' && !$ENV{TEST_IO_PIPE}) {
  34         $reason = 'Win32 testing environment not set';
  35     }
  36     if ($reason) {
  37         print "1..0 # Skip: $reason\n";
  38         exit 0;
  39     }
  40 }
  41
  42 use IO::Pipe;
  43
  44 my $is_win32=$^O eq 'MSWin32' ? "MSWin32 has broken pipes" : "";
  45
  46 $| = 1;
  47 print "1..10\n";
  48
  49 if ($is_win32) {
  50     print "ok $_ # skipped: $is_win32\n" for 1..4;
  51 } else {
  52     $pipe = new IO::Pipe->reader($perl, '-e', 'print qq(not ok 1)\n"');
  53     while (<$pipe>) {
  54       s/^not //;
  55       print;
  56     }
  57     $pipe->close or print "# \$!=$!\nnot ";
  58     print "ok 2\n";
  59     $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //';
  60     $pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
  61     print $pipe "not ok 3\n" ;
  62     $pipe->close or print "# \$!=$!\nnot ";
  63     print "ok 4\n";
  64 }
  65
  66 # Check if can fork with dynamic extensions (bug in CRT):
  67 if ($^O eq 'os2' and
  68     system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
  69     print "ok $_ # skipped: broken fork\n" for 5..10;
  70     exit 0;
  71 }
  72
  73 $pipe = new IO::Pipe;
  74
  75 $pid = fork();
  76
  77 if($pid)
  78  {
  79   $pipe->writer;
  80   print $pipe "Xk 5\n";
  81   print $pipe "oY 6\n";
  82   $pipe->close;
  83   wait;
  84  }
  85 elsif(defined $pid)
  86  {
  87   $pipe->reader;
  88   $stdin = bless \*STDIN, "IO::Handle";
  89   $stdin->fdopen($pipe,"r");
  90   exec $^X, '-pne', 'tr/YX/ko/';
  91  }
  92 else
  93  {
  94   die "# error = $!";
  95  }
  96
  97 if ($is_win32) {
  98     print "ok $_ # skipped: $is_win32\n" for 7..8;
  99 } else {
 100     $pipe = new IO::Pipe;
 101     $pid = fork();
 102
 103     if($pid)
 104  {
 105   $pipe->reader;
 106   while(<$pipe>) {
 107       s/^not //;
 108       print;
 109   }
 110   $pipe->close;
 111   wait;
 112  }
 113     elsif(defined $pid)
 114  {
 115   $pipe->writer;
 116
 117   $stdout = bless \*STDOUT, "IO::Handle";
 118   $stdout->fdopen($pipe,"w");
 119   print STDOUT "not ok 7\n";
 120   exec 'echo', 'not ok 8';
 121  }
 122     else
 123  {
 124   die;
 125  }
 126 }
 127 if ($is_win32) {
 128     print "ok $_ # skipped: $is_win32\n" for 9;
 129 } else {
 130     $pipe = new IO::Pipe;
 131     $pipe->writer;
 132
 133     $SIG{'PIPE'} = 'broken_pipe';
 134
 135     sub broken_pipe {
 136     print "ok 9\n";
 137     }
 138
 139     print $pipe "not ok 9\n";
 140     $pipe->close;
 141
 142     sleep 1;
 143 }
 144 print "ok 10\n";
 145