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