diff options
Diffstat (limited to 't/test-terminal.perl')
-rwxr-xr-x | t/test-terminal.perl | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/t/test-terminal.perl b/t/test-terminal.perl new file mode 100755 index 0000000000..46bf618479 --- /dev/null +++ b/t/test-terminal.perl @@ -0,0 +1,105 @@ +#!/usr/bin/perl +use 5.008; +use strict; +use warnings; +use IO::Pty; +use File::Copy; + +# Run @$argv in the background with stdio redirected to $in, $out and $err. +sub start_child { + my ($argv, $in, $out, $err) = @_; + my $pid = fork; + if (not defined $pid) { + die "fork failed: $!" + } elsif ($pid == 0) { + open STDIN, "<&", $in; + open STDOUT, ">&", $out; + open STDERR, ">&", $err; + close $in; + close $out; + exec(@$argv) or die "cannot exec '$argv->[0]': $!" + } + return $pid; +} + +# Wait for $pid to finish. +sub finish_child { + # Simplified from wait_or_whine() in run-command.c. + my ($pid) = @_; + + my $waiting = waitpid($pid, 0); + if ($waiting < 0) { + die "waitpid failed: $!"; + } elsif ($? & 127) { + my $code = $? & 127; + warn "died of signal $code"; + return $code + 128; + } else { + return $? >> 8; + } +} + +sub xsendfile { + my ($out, $in) = @_; + + # Note: the real sendfile() cannot read from a terminal. + + # It is unspecified by POSIX whether reads + # from a disconnected terminal will return + # EIO (as in AIX 4.x, IRIX, and Linux) or + # end-of-file. Either is fine. + copy($in, $out, 4096) or $!{EIO} or die "cannot copy from child: $!"; +} + +sub copy_stdin { + my ($in) = @_; + my $pid = fork; + if (!$pid) { + xsendfile($in, \*STDIN); + exit 0; + } + close($in); + return $pid; +} + +sub copy_stdio { + my ($out, $err) = @_; + my $pid = fork; + defined $pid or die "fork failed: $!"; + if (!$pid) { + close($out); + xsendfile(\*STDERR, $err); + exit 0; + } + close($err); + xsendfile(\*STDOUT, $out); + finish_child($pid) == 0 + or exit 1; +} + +if ($#ARGV < 1) { + die "usage: test-terminal program args"; +} +$ENV{TERM} = 'vt100'; +my $master_in = new IO::Pty; +my $master_out = new IO::Pty; +my $master_err = new IO::Pty; +$master_in->set_raw(); +$master_out->set_raw(); +$master_err->set_raw(); +$master_in->slave->set_raw(); +$master_out->slave->set_raw(); +$master_err->slave->set_raw(); +my $pid = start_child(\@ARGV, $master_in->slave, $master_out->slave, $master_err->slave); +close $master_in->slave; +close $master_out->slave; +close $master_err->slave; +my $in_pid = copy_stdin($master_in); +copy_stdio($master_out, $master_err); +my $ret = finish_child($pid); +# If the child process terminates before our copy_stdin() process is able to +# write all of its data to $master_in, the copy_stdin() process could stall. +# Send SIGTERM to it to ensure it terminates. +kill 'TERM', $in_pid; +finish_child($in_pid); +exit($ret); |