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