1#!./perl -w
2
3BEGIN {
4    require Config; import Config;
5    if (!$Config{'d_fork'}
6       # open2/3 supported on win32
7       && $^O ne 'MSWin32' && $^O ne 'NetWare')
8    {
9	print "1..0\n";
10	exit 0;
11    }
12    # make warnings fatal
13    $SIG{__WARN__} = sub { die @_ };
14}
15
16use strict;
17use Test::More tests => 37;
18
19use IO::Handle;
20use IPC::Open3;
21
22my $perl = $^X;
23
24sub cmd_line {
25	if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
26		my $cmd = shift;
27		$cmd =~ tr/\r\n//d;
28		$cmd =~ s/"/\\"/g;
29		return qq/"$cmd"/;
30	}
31	else {
32		return $_[0];
33	}
34}
35
36my ($pid, $reaped_pid);
37STDOUT->autoflush;
38STDERR->autoflush;
39
40# basic
41$pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
42    $| = 1;
43    print scalar <STDIN>;
44    print STDERR "hi error\n";
45EOF
46cmp_ok($pid, '!=', 0);
47isnt((print WRITE "hi kid\n"), 0);
48like(scalar <READ>, qr/^hi kid\r?\n$/);
49like(scalar <ERROR>, qr/^hi error\r?\n$/);
50is(close(WRITE), 1) or diag($!);
51is(close(READ), 1) or diag($!);
52is(close(ERROR), 1) or diag($!);
53$reaped_pid = waitpid $pid, 0;
54is($reaped_pid, $pid);
55is($?, 0);
56
57my $desc = "read and error together, both named";
58$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
59    $| = 1;
60    print scalar <STDIN>;
61    print STDERR scalar <STDIN>;
62EOF
63print WRITE "$desc\n";
64like(scalar <READ>, qr/\A$desc\r?\n\z/);
65print WRITE "$desc [again]\n";
66like(scalar <READ>, qr/\A$desc \[again\]\r?\n\z/);
67waitpid $pid, 0;
68
69$desc = "read and error together, error empty";
70$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
71    $| = 1;
72    print scalar <STDIN>;
73    print STDERR scalar <STDIN>;
74EOF
75print WRITE "$desc\n";
76like(scalar <READ>, qr/\A$desc\r?\n\z/);
77print WRITE "$desc [again]\n";
78like(scalar <READ>, qr/\A$desc \[again\]\r?\n\z/);
79waitpid $pid, 0;
80
81is(pipe(PIPE_READ, PIPE_WRITE), 1);
82$pid = open3 '<&PIPE_READ', 'READ', '',
83		    $perl, '-e', cmd_line('print scalar <STDIN>');
84close PIPE_READ;
85print PIPE_WRITE "dup writer\n";
86close PIPE_WRITE;
87like(scalar <READ>, qr/\Adup writer\r?\n\z/);
88waitpid $pid, 0;
89
90my $TB = Test::Builder->new();
91my $test = $TB->current_test;
92# dup reader
93$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
94		    $perl, '-e', cmd_line('print scalar <STDIN>');
95++$test;
96print WRITE "ok $test\n";
97waitpid $pid, 0;
98
99{
100    package YAAH;
101    $pid = IPC::Open3::open3('QWACK_WAAK_WAAK', '>&STDOUT', 'ERROR',
102			     $perl, '-e', main::cmd_line('print scalar <STDIN>'));
103    ++$test;
104    no warnings 'once';
105    print QWACK_WAAK_WAAK "ok $test # filenames qualified to their package\n";
106    waitpid $pid, 0;
107}
108
109# dup error:  This particular case, duping stderr onto the existing
110# stdout but putting stdout somewhere else, is a good case because it
111# used not to work.
112$pid = open3 'WRITE', 'READ', '>&STDOUT',
113		    $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
114++$test;
115print WRITE "ok $test\n";
116waitpid $pid, 0;
117
118foreach (['>&STDOUT', 'both named'],
119	 ['', 'error empty'],
120	) {
121    my ($err, $desc) = @$_;
122    $pid = open3 'WRITE', '>&STDOUT', $err, $perl, '-e', cmd_line(<<'EOF');
123    $| = 1;
124    print STDOUT scalar <STDIN>;
125    print STDERR scalar <STDIN>;
126EOF
127    printf WRITE "ok %d # dup reader and error together, $desc\n", ++$test
128	for 0, 1;
129    waitpid $pid, 0;
130}
131
132# command line in single parameter variant of open3
133# for understanding of Config{'sh'} test see exec description in camel book
134my $cmd = 'print(scalar(<STDIN>))';
135$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd);
136$pid = eval { open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
137if ($@) {
138	print "error $@\n";
139	++$test;
140	print WRITE "not ok $test\n";
141}
142else {
143	++$test;
144	print WRITE "ok $test\n";
145	waitpid $pid, 0;
146}
147$TB->current_test($test);
148
149# RT 72016
150{
151    local $::TODO = "$^O returns a pid and doesn't throw an exception"
152	if $^O eq 'MSWin32';
153    $pid = eval { open3 'WRITE', 'READ', 'ERROR', '/non/existent/program'; };
154    isnt($@, '',
155	 'open3 of a non existent program fails with an exception in the parent')
156	or do {waitpid $pid, 0};
157}
158
159$pid = eval { open3 'WRITE', '', 'ERROR', '/non/existent/program'; };
160like($@, qr/^open3: Modification of a read-only value attempted at /,
161     'open3 faults read-only parameters correctly') or do {waitpid $pid, 0};
162
163foreach my $handle (qw (DUMMY STDIN STDOUT STDERR)) {
164    local $::{$handle};
165    my $out = IO::Handle->new();
166    my $pid = eval {
167	local $SIG{__WARN__} = sub {
168	    open my $fh, '>/dev/tty';
169	    return if "@_" =~ m!^Use of uninitialized value \$fd.*IO/Handle\.pm!;
170	    print $fh "@_";
171	    die @_
172	};
173	open3 undef, $out, undef, $perl, '-le', "print q _# ${handle}_"
174    };
175    is($@, '', "No errors with localised $handle");
176    cmp_ok($pid, '>', 0, "Got a pid with localised $handle");
177    if ($handle eq 'STDOUT') {
178	is(<$out>, undef, "Expected no output with localised $handle");
179    } else {
180	like(<$out>, qr/\A# $handle\r?\n\z/,
181	     "Expected output with localised $handle");
182    }
183    waitpid $pid, 0;
184}
185