Andrew's git - gitweb.git/blob - t/test-terminal.perl

   1#!/usr/bin/perl
   2use 5.008;
   3use strict;
   4use warnings;
   5use IO::Pty;
   6use File::Copy;
   7
   8# Run @$argv in the background with stdio redirected to $out and $err.
   9sub 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.
  24sub 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
  40sub 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
  52sub 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
  67if ($#ARGV < 1) {
  68        die "usage: test-terminal program args";
  69}
  70my $master_out = new IO::Pty;
  71my $master_err = new IO::Pty;
  72$master_out->set_raw();
  73$master_err->set_raw();
  74$master_out->slave->set_raw();
  75$master_err->slave->set_raw();
  76my $pid = start_child(\@ARGV, $master_out->slave, $master_err->slave);
  77close $master_out->slave;
  78close $master_err->slave;
  79copy_stdio($master_out, $master_err);
  80exit(finish_child($pid));