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