dist/IO/t/io_pipe.t

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