1#!./perl -w
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require Config; import Config;
7    if (!$Config{'d_fork'}
8       # open2/3 supported on win32 (but not Borland due to CRT bugs)
9       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
10    {
11	print "1..0\n";
12	exit 0;
13    }
14    # make warnings fatal
15    $SIG{__WARN__} = sub { die @_ };
16}
17
18use strict;
19use IO::Handle;
20use IPC::Open3;
21#require 'open3.pl'; use subs 'open3';
22
23my $perl = $^X;
24
25sub ok {
26    my ($n, $result, $info) = @_;
27    if ($result) {
28	print "ok $n\n";
29    }
30    else {
31	print "not ok $n\n";
32	print "# $info\n" if $info;
33    }
34}
35
36sub cmd_line {
37	if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
38		my $cmd = shift;
39		$cmd =~ tr/\r\n//d;
40		$cmd =~ s/"/\\"/g;
41		return qq/"$cmd"/;
42	}
43	else {
44		return $_[0];
45	}
46}
47
48my ($pid, $reaped_pid);
49STDOUT->autoflush;
50STDERR->autoflush;
51
52print "1..22\n";
53
54# basic
55ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
56    $| = 1;
57    print scalar <STDIN>;
58    print STDERR "hi error\n";
59EOF
60ok 2, print WRITE "hi kid\n";
61ok 3, <READ> =~ /^hi kid\r?\n$/;
62ok 4, <ERROR> =~ /^hi error\r?\n$/;
63ok 5, close(WRITE), $!;
64ok 6, close(READ), $!;
65ok 7, close(ERROR), $!;
66$reaped_pid = waitpid $pid, 0;
67ok 8, $reaped_pid == $pid, $reaped_pid;
68ok 9, $? == 0, $?;
69
70# read and error together, both named
71$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
72    $| = 1;
73    print scalar <STDIN>;
74    print STDERR scalar <STDIN>;
75EOF
76print WRITE "ok 10\n";
77print scalar <READ>;
78print WRITE "ok 11\n";
79print scalar <READ>;
80waitpid $pid, 0;
81
82# read and error together, error empty
83$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
84    $| = 1;
85    print scalar <STDIN>;
86    print STDERR scalar <STDIN>;
87EOF
88print WRITE "ok 12\n";
89print scalar <READ>;
90print WRITE "ok 13\n";
91print scalar <READ>;
92waitpid $pid, 0;
93
94# dup writer
95ok 14, pipe PIPE_READ, PIPE_WRITE;
96$pid = open3 '<&PIPE_READ', 'READ', '',
97		    $perl, '-e', cmd_line('print scalar <STDIN>');
98close PIPE_READ;
99print PIPE_WRITE "ok 15\n";
100close PIPE_WRITE;
101print scalar <READ>;
102waitpid $pid, 0;
103
104# dup reader
105$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
106		    $perl, '-e', cmd_line('print scalar <STDIN>');
107print WRITE "ok 16\n";
108waitpid $pid, 0;
109
110# dup error:  This particular case, duping stderr onto the existing
111# stdout but putting stdout somewhere else, is a good case because it
112# used not to work.
113$pid = open3 'WRITE', 'READ', '>&STDOUT',
114		    $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
115print WRITE "ok 17\n";
116waitpid $pid, 0;
117
118# dup reader and error together, both named
119$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF');
120    $| = 1;
121    print STDOUT scalar <STDIN>;
122    print STDERR scalar <STDIN>;
123EOF
124print WRITE "ok 18\n";
125print WRITE "ok 19\n";
126waitpid $pid, 0;
127
128# dup reader and error together, error empty
129$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF');
130    $| = 1;
131    print STDOUT scalar <STDIN>;
132    print STDERR scalar <STDIN>;
133EOF
134print WRITE "ok 20\n";
135print WRITE "ok 21\n";
136waitpid $pid, 0;
137
138# command line in single parameter variant of open3
139# for understanding of Config{'sh'} test see exec description in camel book
140my $cmd = 'print(scalar(<STDIN>))';
141$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd);
142eval{$pid = open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
143if ($@) {
144	print "error $@\n";
145	print "not ok 22\n";
146}
147else {
148	print WRITE "ok 22\n";
149	waitpid $pid, 0;
150}
151