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 $in, $out and $err.
   9sub start_child {
  10        my ($argv, $in, $out, $err) = @_;
  11        my $pid = fork;
  12        if (not defined $pid) {
  13                die "fork failed: $!"
  14        } elsif ($pid == 0) {
  15                open STDIN, "<&", $in;
  16                open STDOUT, ">&", $out;
  17                open STDERR, ">&", $err;
  18                close $in;
  19                close $out;
  20                exec(@$argv) or die "cannot exec '$argv->[0]': $!"
  21        }
  22        return $pid;
  23}
  24
  25# Wait for $pid to finish.
  26sub finish_child {
  27        # Simplified from wait_or_whine() in run-command.c.
  28        my ($pid) = @_;
  29
  30        my $waiting = waitpid($pid, 0);
  31        if ($waiting < 0) {
  32                die "waitpid failed: $!";
  33        } elsif ($? & 127) {
  34                my $code = $? & 127;
  35                warn "died of signal $code";
  36                return $code + 128;
  37        } else {
  38                return $? >> 8;
  39        }
  40}
  41
  42sub xsendfile {
  43        my ($out, $in) = @_;
  44
  45        # Note: the real sendfile() cannot read from a terminal.
  46
  47        # It is unspecified by POSIX whether reads
  48        # from a disconnected terminal will return
  49        # EIO (as in AIX 4.x, IRIX, and Linux) or
  50        # end-of-file.  Either is fine.
  51        copy($in, $out, 4096) or $!{EIO} or die "cannot copy from child: $!";
  52}
  53
  54sub copy_stdin {
  55        my ($in) = @_;
  56        my $pid = fork;
  57        if (!$pid) {
  58                xsendfile($in, \*STDIN);
  59                exit 0;
  60        }
  61        close($in);
  62        return $pid;
  63}
  64
  65sub copy_stdio {
  66        my ($out, $err) = @_;
  67        my $pid = fork;
  68        defined $pid or die "fork failed: $!";
  69        if (!$pid) {
  70                close($out);
  71                xsendfile(\*STDERR, $err);
  72                exit 0;
  73        }
  74        close($err);
  75        xsendfile(\*STDOUT, $out);
  76        finish_child($pid) == 0
  77                or exit 1;
  78}
  79
  80if ($#ARGV < 1) {
  81        die "usage: test-terminal program args";
  82}
  83$ENV{TERM} = 'vt100';
  84my $master_in = new IO::Pty;
  85my $master_out = new IO::Pty;
  86my $master_err = new IO::Pty;
  87$master_in->set_raw();
  88$master_out->set_raw();
  89$master_err->set_raw();
  90$master_in->slave->set_raw();
  91$master_out->slave->set_raw();
  92$master_err->slave->set_raw();
  93my $pid = start_child(\@ARGV, $master_in->slave, $master_out->slave, $master_err->slave);
  94close $master_in->slave;
  95close $master_out->slave;
  96close $master_err->slave;
  97my $in_pid = copy_stdin($master_in);
  98copy_stdio($master_out, $master_err);
  99my $ret = finish_child($pid);
 100# If the child process terminates before our copy_stdin() process is able to
 101# write all of its data to $master_in, the copy_stdin() process could stall.
 102# Send SIGTERM to it to ensure it terminates.
 103kill 'TERM', $in_pid;
 104finish_child($in_pid);
 105exit($ret);