t/lib/open2.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require Config; import Config;
   7     unless ($Config{'d_fork'}) {
   8         print "1..0\n";
   9         exit 0;
  10     }
  11     # make warnings fatal
  12     $SIG{__WARN__} = sub { die @_ };
  13 }
  14
  15 use strict;
  16 use IO::Handle;
  17 use IPC::Open2;
  18 #require 'open2.pl'; use subs 'open2';
  19
  20 my $perl = './perl';
  21
  22 sub ok {
  23     my ($n, $result, $info) = @_;
  24     if ($result) {
  25         print "ok $n\n";
  26     }
  27     else {
  28         print "not ok $n\n";
  29         print "# $info\n" if $info;
  30     }
  31 }
  32
  33 my ($pid, $reaped_pid);
  34 STDOUT->autoflush;
  35 STDERR->autoflush;
  36
  37 print "1..7\n";
  38
  39 ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e', 'print scalar <STDIN>';
  40 ok 2, print WRITE "hi kid\n";
  41 ok 3, <READ> eq "hi kid\n";
  42 ok 4, close(WRITE), $!;
  43 ok 5, close(READ), $!;
  44 $reaped_pid = waitpid $pid, 0;
  45 ok 6, $reaped_pid == $pid, $reaped_pid;
  46 ok 7, $? == 0, $?;