home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / io_pipe.t < prev    next >
Text File  |  1999-07-20  |  2KB  |  124 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     unless(grep /blib/, @INC) {
  5.     chdir 't' if -d 't';
  6.     unshift @INC, '../lib' if -d '../lib';
  7.     }
  8. }
  9.  
  10. use Config;
  11.  
  12. BEGIN {
  13.     if(-d "lib" && -f "TEST") {
  14.     my $reason;
  15.     if (! $Config{'d_fork'}) {
  16.         $reason = 'no fork';
  17.     }
  18.     elsif ($Config{'extensions'} !~ /\bIO\b/) {
  19.         $reason = 'IO extension unavailable';
  20.     }
  21.     undef $reason if $^O eq 'VMS';
  22.     if ($reason) {
  23.         print "1..0 # Skip: $reason\n";
  24.         exit 0;
  25.         }
  26.     }
  27. }
  28.  
  29. use IO::Pipe;
  30.  
  31. my $perl = './perl';
  32.  
  33. $| = 1;
  34. print "1..10\n";
  35.  
  36. $pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"');
  37. while (<$pipe>) {
  38.   s/^not //;
  39.   print;
  40. }
  41. $pipe->close or print "# \$!=$!\nnot ";
  42. print "ok 2\n";
  43.  
  44. $cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //';
  45. $pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
  46. print $pipe "not ok 3\n" ;
  47. $pipe->close or print "# \$!=$!\nnot ";
  48. print "ok 4\n";
  49.  
  50. # Check if can fork with dynamic extensions (bug in CRT):
  51. if ($^O eq 'os2' and
  52.     system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
  53.     print "ok $_ # skipped: broken fork\n" for 5..10;
  54.     exit 0;
  55. }
  56.  
  57. $pipe = new IO::Pipe;
  58.  
  59. $pid = fork();
  60.  
  61. if($pid)
  62.  {
  63.   $pipe->writer;
  64.   print $pipe "Xk 5\n";
  65.   print $pipe "oY 6\n";
  66.   $pipe->close;
  67.   wait;
  68.  }
  69. elsif(defined $pid)
  70.  {
  71.   $pipe->reader;
  72.   $stdin = bless \*STDIN, "IO::Handle";
  73.   $stdin->fdopen($pipe,"r");
  74.   exec 'tr', 'YX', 'ko';
  75.  }
  76. else
  77.  {
  78.   die "# error = $!";
  79.  }
  80.  
  81. $pipe = new IO::Pipe;
  82. $pid = fork();
  83.  
  84. if($pid)
  85.  {
  86.   $pipe->reader;
  87.   while(<$pipe>) {
  88.       s/^not //;
  89.       print;
  90.   }
  91.   $pipe->close;
  92.   wait;
  93.  }
  94. elsif(defined $pid)
  95.  {
  96.   $pipe->writer;
  97.  
  98.   $stdout = bless \*STDOUT, "IO::Handle";
  99.   $stdout->fdopen($pipe,"w");
  100.   print STDOUT "not ok 7\n";
  101.   exec 'echo', 'not ok 8';
  102.  }
  103. else
  104.  {
  105.   die;
  106.  }
  107.  
  108. $pipe = new IO::Pipe;
  109. $pipe->writer;
  110.  
  111. $SIG{'PIPE'} = 'broken_pipe';
  112.  
  113. sub broken_pipe {
  114.     print "ok 9\n";
  115. }
  116.  
  117. print $pipe "not ok 9\n";
  118. $pipe->close;
  119.  
  120. sleep 1;
  121.  
  122. print "ok 10\n";
  123.  
  124.