t/test-terminal.perl

   1 #!/usr/bin/perl
   2 use 5.008;
   3 use strict;
   4 use warnings;
   5 use IO::Pty;
   6 use File::Copy;
   7
   8 # Run @$argv in the background with stdio redirected to $out and $err.
   9 sub start_child {
  10         my ($argv, $out, $err) = @_;
  11         my $pid = fork;
  12         if (not defined $pid) {
  13                 die "fork failed: $!"
  14         } elsif ($pid == 0) {
  15                 open STDOUT, ">&", $out;
  16                 open STDERR, ">&", $err;
  17                 close $out;
  18                 exec(@$argv) or die "cannot exec '$argv->[0]': $!"
  19         }
  20         return $pid;
  21 }
  22
  23 # Wait for $pid to finish.
  24 sub finish_child {
  25         # Simplified from wait_or_whine() in run-command.c.
  26         my ($pid) = @_;
  27
  28         my $waiting = waitpid($pid, 0);
  29         if ($waiting < 0) {
  30                 die "waitpid failed: $!";
  31         } elsif ($? & 127) {
  32                 my $code = $? & 127;
  33                 warn "died of signal $code";
  34                 return $code - 128;
  35         } else {
  36                 return $? >> 8;
  37         }
  38 }
  39
  40 sub xsendfile {
  41         my ($out, $in) = @_;
  42
  43         # Note: the real sendfile() cannot read from a terminal.
  44
  45         # It is unspecified by POSIX whether reads
  46         # from a disconnected terminal will return
  47         # EIO (as in AIX 4.x, IRIX, and Linux) or
  48         # end-of-file.  Either is fine.
  49         copy($in, $out, 4096) or $!{EIO} or die "cannot copy from child: $!";
  50 }
  51
  52 sub copy_stdio {
  53         my ($out, $err) = @_;
  54         my $pid = fork;
  55         defined $pid or die "fork failed: $!";
  56         if (!$pid) {
  57                 close($out);
  58                 xsendfile(\*STDERR, $err);
  59                 exit 0;
  60         }
  61         close($err);
  62         xsendfile(\*STDOUT, $out);
  63         finish_child($pid) == 0
  64                 or exit 1;
  65 }
  66
  67 if ($#ARGV < 1) {
  68         die "usage: test-terminal program args";
  69 }
  70 my $master_out = new IO::Pty;
  71 my $master_err = new IO::Pty;
  72 my $pid = start_child(\@ARGV, $master_out->slave, $master_err->slave);
  73 close $master_out->slave;
  74 close $master_err->slave;
  75 copy_stdio($master_out, $master_err);
  76 exit(finish_child($pid));