t/io/pipe.t

   1 #!./perl
   2
   3 # $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $
   4
   5 $| = 1;
   6 print "1..8\n";
   7
   8 open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
   9 print PIPE "Xk 1\n";
  10 print PIPE "oY 2\n";
  11 close PIPE;
  12
  13 if (open(PIPE, "-|")) {
  14     while(<PIPE>) {
  15         s/^not //;
  16         print;
  17     }
  18 }
  19 else {
  20     print STDOUT "not ok 3\n";
  21     exec 'echo', 'not ok 4';
  22 }
  23
  24 pipe(READER,WRITER) || die "Can't open pipe";
  25
  26 if ($pid = fork) {
  27     close WRITER;
  28     while(<READER>) {
  29         s/^not //;
  30         y/A-Z/a-z/;
  31         print;
  32     }
  33 }
  34 else {
  35     die "Couldn't fork" unless defined $pid;
  36     close READER;
  37     print WRITER "not ok 5\n";
  38     open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT";
  39     close WRITER;
  40     exec 'echo', 'not ok 6';
  41 }
  42
  43
  44 pipe(READER,WRITER) || die "Can't open pipe";
  45 close READER;
  46
  47 $SIG{'PIPE'} = 'broken_pipe';
  48
  49 sub broken_pipe {
  50     print "ok 7\n";
  51 }
  52
  53 print WRITER "not ok 7\n";
  54 close WRITER;
  55
  56 print "ok 8\n";