Commit | Line | Data |
---|---|---|
7e1af8bc | 1 | #!./perl -w |
7e1af8bc | 2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
93430cb4 | 5 | unshift @INC, '../lib'; |
774d564b | 6 | require Config; import Config; |
f55ee38a GS |
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 | ||
945d6bad | 23 | my $perl = $^X; |
774d564b | 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 GS |
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 | ||
7083d4d1 | 52 | print "1..22\n"; |
7e1af8bc | 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 GS |
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; | |
7083d4d1 GS |
137 | |
138 | # command line in single parameter variant of open3 | |
139 | # for understanding of Config{'sh'} test see exec description in camel book | |
140 | my $cmd = 'print(scalar(<STDIN>))'; | |
141 | $cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd); | |
142 | eval{$pid = open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; }; | |
143 | if ($@) { | |
144 | print "error $@\n"; | |
145 | print "not ok 22\n"; | |
146 | } | |
147 | else { | |
148 | print WRITE "ok 22\n"; | |
149 | waitpid $pid, 0; | |
150 | } |