Commit | Line | Data |
378cc40b |
1 | #!./perl |
2 | |
774d564b |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
774d564b |
6 | require Config; import Config; |
7 | unless ($Config{'d_fork'}) { |
45c0de28 |
8 | print "1..0 # Skip: no fork\n"; |
774d564b |
9 | exit 0; |
10 | } |
11 | } |
12 | |
378cc40b |
13 | $| = 1; |
f2b5be74 |
14 | print "1..15\n"; |
378cc40b |
15 | |
092bebab |
16 | # External program 'tr' assumed. |
c07a80fd |
17 | open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); |
18 | print PIPE "Xk 1\n"; |
19 | print PIPE "oY 2\n"; |
378cc40b |
20 | close PIPE; |
21 | |
092bebab |
22 | if ($^O eq 'vmesa') { |
23 | # Doesn't work, yet. |
6fd78b6e |
24 | for (3..6) { |
25 | print "ok $_ # skipped\n"; |
26 | } |
092bebab |
27 | } else { |
28 | if (open(PIPE, "-|")) { |
29 | while(<PIPE>) { |
30 | s/^not //; |
31 | print; |
32 | } |
33 | close PIPE; # avoid zombies which disrupt test 12 |
34 | } |
35 | else { |
36 | # External program 'echo' assumed. |
37 | print STDOUT "not ok 3\n"; |
38 | exec 'echo', 'not ok 4'; |
378cc40b |
39 | } |
ac58e20f |
40 | |
092bebab |
41 | pipe(READER,WRITER) || die "Can't open pipe"; |
ac58e20f |
42 | |
092bebab |
43 | if ($pid = fork) { |
44 | close WRITER; |
45 | while(<READER>) { |
46 | s/^not //; |
47 | y/A-Z/a-z/; |
48 | print; |
49 | } |
50 | close READER; # avoid zombies which disrupt test 12 |
51 | } |
52 | else { |
53 | die "Couldn't fork" unless defined $pid; |
54 | close READER; |
55 | print WRITER "not ok 5\n"; |
56 | open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT"; |
57 | close WRITER; |
58 | # External program 'echo' assumed. |
59 | exec 'echo', 'not ok 6'; |
ac58e20f |
60 | } |
ac58e20f |
61 | } |
d6a255e6 |
62 | wait; # Collect from $pid |
ac58e20f |
63 | |
ac58e20f |
64 | pipe(READER,WRITER) || die "Can't open pipe"; |
65 | close READER; |
66 | |
67 | $SIG{'PIPE'} = 'broken_pipe'; |
68 | |
69 | sub broken_pipe { |
1d2dff63 |
70 | $SIG{'PIPE'} = 'IGNORE'; # loop preventer |
ac58e20f |
71 | print "ok 7\n"; |
72 | } |
73 | |
74 | print WRITER "not ok 7\n"; |
75 | close WRITER; |
3d57aefb |
76 | sleep 1; |
ac58e20f |
77 | print "ok 8\n"; |
03136e13 |
78 | |
79 | # VMS doesn't like spawning subprocesses that are still connected to |
1d3434b8 |
80 | # STDOUT. Someone should modify tests #9 to #12 to work with VMS. |
03136e13 |
81 | |
82 | if ($^O eq 'VMS') { |
6fd78b6e |
83 | print "ok 9 # skipped\n"; |
84 | print "ok 10 # skipped\n"; |
85 | print "ok 11 # skipped\n"; |
86 | print "ok 12 # skipped\n"; |
03136e13 |
87 | exit; |
88 | } |
89 | |
e5e1b98b |
90 | if ($Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || $^O eq 'posix-bc') { |
03136e13 |
91 | # Sfio doesn't report failure when closing a broken pipe |
fc261528 |
92 | # that has pending output. Go figure. MachTen doesn't either, |
93 | # but won't write to broken pipes, so nothing's pending at close. |
6ee623d5 |
94 | # BeOS will not write to broken pipes, either. |
e5e1b98b |
95 | # Nor does POSIX-BC. |
6fd78b6e |
96 | print "ok 9 # skipped\n"; |
03136e13 |
97 | } |
98 | else { |
99 | local $SIG{PIPE} = 'IGNORE'; |
100 | open NIL, '|true' or die "open failed: $!"; |
ac230105 |
101 | sleep 5; |
5e2ab84b |
102 | if (print NIL 'foo') { |
103 | # If print was allowed we had better get an error on close |
104 | if (close NIL) { |
105 | print "not ok 9\n"; |
106 | } |
107 | else { |
108 | print "ok 9\n"; |
109 | } |
03136e13 |
110 | } |
111 | else { |
5e2ab84b |
112 | # If print failed, the close should be clean |
113 | if (close NIL) { |
114 | print "ok 9\n"; |
115 | } |
116 | else { |
117 | print "not ok 9\n"; |
118 | } |
03136e13 |
119 | } |
120 | } |
121 | |
092bebab |
122 | if ($^O eq 'vmesa') { |
123 | # These don't work, yet. |
6fd78b6e |
124 | print "ok 10 # skipped\n"; |
125 | print "ok 11 # skipped\n"; |
126 | print "ok 12 # skipped\n"; |
092bebab |
127 | exit; |
128 | } |
129 | |
03136e13 |
130 | # check that errno gets forced to 0 if the piped program exited non-zero |
131 | open NIL, '|exit 23;' or die "fork failed: $!"; |
132 | $! = 1; |
133 | if (close NIL) { |
134 | print "not ok 10\n# successful close\n"; |
135 | } |
136 | elsif ($! != 0) { |
137 | print "not ok 10\n# errno $!\n"; |
138 | } |
139 | elsif ($? == 0) { |
140 | print "not ok 10\n# status 0\n"; |
141 | } |
142 | else { |
143 | print "ok 10\n"; |
144 | } |
1d3434b8 |
145 | |
0994c4d0 |
146 | if ($^O eq 'mpeix') { |
147 | print "ok 11 # skipped\n"; |
148 | print "ok 12 # skipped\n"; |
1d3434b8 |
149 | } else { |
0994c4d0 |
150 | # check that status for the correct process is collected |
151 | my $zombie = fork or exit 37; |
152 | my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n"; |
153 | $SIG{ALRM} = sub { return }; |
154 | alarm(1); |
155 | my $close = close FH; |
156 | if ($? == 13*256 && ! length $close && ! $!) { |
157 | print "ok 11\n"; |
158 | } else { |
159 | print "not ok 11\n# close $close\$?=$? \$!=", $!+0, ":$!\n"; |
160 | }; |
161 | my $wait = wait; |
162 | if ($? == 37*256 && $wait == $zombie && ! $!) { |
163 | print "ok 12\n"; |
164 | } else { |
165 | print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$? \$!=", $!+0, ":$!\n"; |
166 | } |
1d3434b8 |
167 | } |
06eaf0bc |
168 | |
169 | # Test new semantics for missing command in piped open |
170 | # 19990114 M-J. Dominus mjd@plover.com |
171 | { local *P; |
172 | print (((open P, "| " ) ? "not " : ""), "ok 13\n"); |
173 | print (((open P, " |" ) ? "not " : ""), "ok 14\n"); |
174 | } |
f2b5be74 |
175 | |
176 | # check that status is unaffected by implicit close |
177 | { |
178 | local(*NIL); |
179 | open NIL, '|exit 23;' or die "fork failed: $!"; |
180 | $? = 42; |
181 | # NIL implicitly closed here |
182 | } |
183 | if ($? != 42) { |
184 | print "# status $?, expected 42\nnot "; |
185 | } |
186 | print "ok 15\n"; |
187 | $? = 0; |