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; |
7 | unless ($Config{'d_fork'}) { |
8 | print "1..0\n"; |
9 | exit 0; |
10 | } |
7e1af8bc |
11 | # make warnings fatal |
12 | $SIG{__WARN__} = sub { die @_ }; |
13 | } |
14 | |
71be2cbc |
15 | use strict; |
7e1af8bc |
16 | use IO::Handle; |
17 | use IPC::Open3; |
18 | #require 'open3.pl'; use subs 'open3'; |
19 | |
774d564b |
20 | my $perl = './perl'; |
21 | |
7e1af8bc |
22 | sub ok { |
23 | my ($n, $result, $info) = @_; |
24 | if ($result) { |
25 | print "ok $n\n"; |
26 | } |
27 | else { |
28 | print "not ok $n\n"; |
29 | print "# $info\n" if $info; |
30 | } |
31 | } |
32 | |
33 | my ($pid, $reaped_pid); |
34 | STDOUT->autoflush; |
35 | STDERR->autoflush; |
36 | |
37 | print "1..21\n"; |
38 | |
39 | # basic |
774d564b |
40 | ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', <<'EOF'; |
7e1af8bc |
41 | $| = 1; |
42 | print scalar <STDIN>; |
43 | print STDERR "hi error\n"; |
44 | EOF |
45 | ok 2, print WRITE "hi kid\n"; |
46 | ok 3, <READ> eq "hi kid\n"; |
47 | ok 4, <ERROR> eq "hi error\n"; |
48 | ok 5, close(WRITE), $!; |
49 | ok 6, close(READ), $!; |
50 | ok 7, close(ERROR), $!; |
51 | $reaped_pid = waitpid $pid, 0; |
52 | ok 8, $reaped_pid == $pid, $reaped_pid; |
53 | ok 9, $? == 0, $?; |
54 | |
55 | # read and error together, both named |
774d564b |
56 | $pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', <<'EOF'; |
7e1af8bc |
57 | $| = 1; |
58 | print scalar <STDIN>; |
59 | print STDERR scalar <STDIN>; |
60 | EOF |
61 | print WRITE "ok 10\n"; |
62 | print scalar <READ>; |
63 | print WRITE "ok 11\n"; |
64 | print scalar <READ>; |
65 | waitpid $pid, 0; |
66 | |
67 | # read and error together, error empty |
774d564b |
68 | $pid = open3 'WRITE', 'READ', '', $perl, '-e', <<'EOF'; |
7e1af8bc |
69 | $| = 1; |
70 | print scalar <STDIN>; |
71 | print STDERR scalar <STDIN>; |
72 | EOF |
73 | print WRITE "ok 12\n"; |
74 | print scalar <READ>; |
75 | print WRITE "ok 13\n"; |
76 | print scalar <READ>; |
77 | waitpid $pid, 0; |
78 | |
79 | # dup writer |
80 | ok 14, pipe PIPE_READ, PIPE_WRITE; |
81 | $pid = open3 '<&PIPE_READ', 'READ', '', |
774d564b |
82 | $perl, '-e', 'print scalar <STDIN>'; |
7e1af8bc |
83 | close PIPE_READ; |
84 | print PIPE_WRITE "ok 15\n"; |
85 | close PIPE_WRITE; |
86 | print scalar <READ>; |
87 | waitpid $pid, 0; |
88 | |
89 | # dup reader |
90 | $pid = open3 'WRITE', '>&STDOUT', 'ERROR', |
774d564b |
91 | $perl, '-e', 'print scalar <STDIN>'; |
7e1af8bc |
92 | print WRITE "ok 16\n"; |
93 | waitpid $pid, 0; |
94 | |
95 | # dup error: This particular case, duping stderr onto the existing |
96 | # stdout but putting stdout somewhere else, is a good case because it |
97 | # used not to work. |
98 | $pid = open3 'WRITE', 'READ', '>&STDOUT', |
774d564b |
99 | $perl, '-e', 'print STDERR scalar <STDIN>'; |
7e1af8bc |
100 | print WRITE "ok 17\n"; |
101 | waitpid $pid, 0; |
102 | |
103 | # dup reader and error together, both named |
774d564b |
104 | $pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', <<'EOF'; |
7e1af8bc |
105 | $| = 1; |
106 | print STDOUT scalar <STDIN>; |
107 | print STDERR scalar <STDIN>; |
108 | EOF |
109 | print WRITE "ok 18\n"; |
110 | print WRITE "ok 19\n"; |
111 | waitpid $pid, 0; |
112 | |
113 | # dup reader and error together, error empty |
774d564b |
114 | $pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', <<'EOF'; |
7e1af8bc |
115 | $| = 1; |
116 | print STDOUT scalar <STDIN>; |
117 | print STDERR scalar <STDIN>; |
118 | EOF |
119 | print WRITE "ok 20\n"; |
120 | print WRITE "ok 21\n"; |
121 | waitpid $pid, 0; |