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