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

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