Commit | Line | Data |
7e1af8bc |
1 | #!./perl -w |
7e1af8bc |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
774d564b |
6 | require Config; import Config; |
f55ee38a |
7 | if (!$Config{'d_fork'} |
8 | # open2/3 supported on win32 (but not Borland due to CRT bugs) |
9 | && ($^O ne 'MSWin32' || $Config{'cc'} =~ /^bcc/i)) |
10 | { |
774d564b |
11 | print "1..0\n"; |
12 | exit 0; |
13 | } |
7e1af8bc |
14 | # make warnings fatal |
15 | $SIG{__WARN__} = sub { die @_ }; |
16 | } |
17 | |
71be2cbc |
18 | use strict; |
7e1af8bc |
19 | use IO::Handle; |
20 | use IPC::Open3; |
21 | #require 'open3.pl'; use subs 'open3'; |
22 | |
774d564b |
23 | my $perl = './perl'; |
24 | |
7e1af8bc |
25 | sub ok { |
26 | my ($n, $result, $info) = @_; |
27 | if ($result) { |
28 | print "ok $n\n"; |
29 | } |
30 | else { |
f55ee38a |
31 | print "not ok $n\n"; |
7e1af8bc |
32 | print "# $info\n" if $info; |
33 | } |
34 | } |
35 | |
f55ee38a |
36 | sub cmd_line { |
37 | if ($^O eq 'MSWin32') { |
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 | |
7e1af8bc |
48 | my ($pid, $reaped_pid); |
49 | STDOUT->autoflush; |
50 | STDERR->autoflush; |
51 | |
52 | print "1..21\n"; |
53 | |
54 | # basic |
f55ee38a |
55 | ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF'); |
7e1af8bc |
56 | $| = 1; |
57 | print scalar <STDIN>; |
58 | print STDERR "hi error\n"; |
59 | EOF |
60 | ok 2, print WRITE "hi kid\n"; |
f55ee38a |
61 | ok 3, <READ> =~ /^hi kid\r?\n$/; |
62 | ok 4, <ERROR> =~ /^hi error\r?\n$/; |
7e1af8bc |
63 | ok 5, close(WRITE), $!; |
64 | ok 6, close(READ), $!; |
65 | ok 7, close(ERROR), $!; |
66 | $reaped_pid = waitpid $pid, 0; |
67 | ok 8, $reaped_pid == $pid, $reaped_pid; |
68 | ok 9, $? == 0, $?; |
69 | |
70 | # read and error together, both named |
f55ee38a |
71 | $pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF'); |
7e1af8bc |
72 | $| = 1; |
73 | print scalar <STDIN>; |
74 | print STDERR scalar <STDIN>; |
75 | EOF |
76 | print WRITE "ok 10\n"; |
77 | print scalar <READ>; |
78 | print WRITE "ok 11\n"; |
79 | print scalar <READ>; |
80 | waitpid $pid, 0; |
81 | |
82 | # read and error together, error empty |
f55ee38a |
83 | $pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF'); |
7e1af8bc |
84 | $| = 1; |
85 | print scalar <STDIN>; |
86 | print STDERR scalar <STDIN>; |
87 | EOF |
88 | print WRITE "ok 12\n"; |
89 | print scalar <READ>; |
90 | print WRITE "ok 13\n"; |
91 | print scalar <READ>; |
92 | waitpid $pid, 0; |
93 | |
94 | # dup writer |
95 | ok 14, pipe PIPE_READ, PIPE_WRITE; |
96 | $pid = open3 '<&PIPE_READ', 'READ', '', |
f55ee38a |
97 | $perl, '-e', cmd_line('print scalar <STDIN>'); |
7e1af8bc |
98 | close PIPE_READ; |
99 | print PIPE_WRITE "ok 15\n"; |
100 | close PIPE_WRITE; |
101 | print scalar <READ>; |
102 | waitpid $pid, 0; |
103 | |
104 | # dup reader |
105 | $pid = open3 'WRITE', '>&STDOUT', 'ERROR', |
f55ee38a |
106 | $perl, '-e', cmd_line('print scalar <STDIN>'); |
7e1af8bc |
107 | print WRITE "ok 16\n"; |
108 | waitpid $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', |
f55ee38a |
114 | $perl, '-e', cmd_line('print STDERR scalar <STDIN>'); |
7e1af8bc |
115 | print WRITE "ok 17\n"; |
116 | waitpid $pid, 0; |
117 | |
118 | # dup reader and error together, both named |
f55ee38a |
119 | $pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF'); |
7e1af8bc |
120 | $| = 1; |
121 | print STDOUT scalar <STDIN>; |
122 | print STDERR scalar <STDIN>; |
123 | EOF |
124 | print WRITE "ok 18\n"; |
125 | print WRITE "ok 19\n"; |
126 | waitpid $pid, 0; |
127 | |
128 | # dup reader and error together, error empty |
f55ee38a |
129 | $pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF'); |
7e1af8bc |
130 | $| = 1; |
131 | print STDOUT scalar <STDIN>; |
132 | print STDERR scalar <STDIN>; |
133 | EOF |
134 | print WRITE "ok 20\n"; |
135 | print WRITE "ok 21\n"; |
136 | waitpid $pid, 0; |