Commit | Line | Data |
378cc40b |
1 | #!./perl |
2 | |
79072805 |
3 | # $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $ |
378cc40b |
4 | |
774d564b |
5 | BEGIN { |
6 | chdir 't' if -d 't'; |
7 | @INC = '../lib'; |
8 | require Config; import Config; |
9 | unless ($Config{'d_fork'}) { |
10 | print "1..0\n"; |
11 | exit 0; |
12 | } |
13 | } |
14 | |
378cc40b |
15 | $| = 1; |
1d3434b8 |
16 | print "1..12\n"; |
378cc40b |
17 | |
092bebab |
18 | # External program 'tr' assumed. |
c07a80fd |
19 | open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); |
20 | print PIPE "Xk 1\n"; |
21 | print PIPE "oY 2\n"; |
378cc40b |
22 | close PIPE; |
23 | |
092bebab |
24 | if ($^O eq 'vmesa') { |
25 | # Doesn't work, yet. |
26 | print "ok 3\n"; |
27 | print "ok 4\n"; |
28 | print "ok 5\n"; |
29 | print "ok 6\n"; |
30 | } else { |
31 | if (open(PIPE, "-|")) { |
32 | while(<PIPE>) { |
33 | s/^not //; |
34 | print; |
35 | } |
36 | close PIPE; # avoid zombies which disrupt test 12 |
37 | } |
38 | else { |
39 | # External program 'echo' assumed. |
40 | print STDOUT "not ok 3\n"; |
41 | exec 'echo', 'not ok 4'; |
378cc40b |
42 | } |
ac58e20f |
43 | |
092bebab |
44 | pipe(READER,WRITER) || die "Can't open pipe"; |
ac58e20f |
45 | |
092bebab |
46 | if ($pid = fork) { |
47 | close WRITER; |
48 | while(<READER>) { |
49 | s/^not //; |
50 | y/A-Z/a-z/; |
51 | print; |
52 | } |
53 | close READER; # avoid zombies which disrupt test 12 |
54 | } |
55 | else { |
56 | die "Couldn't fork" unless defined $pid; |
57 | close READER; |
58 | print WRITER "not ok 5\n"; |
59 | open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT"; |
60 | close WRITER; |
61 | # External program 'echo' assumed. |
62 | exec 'echo', 'not ok 6'; |
ac58e20f |
63 | } |
ac58e20f |
64 | } |
65 | |
ac58e20f |
66 | pipe(READER,WRITER) || die "Can't open pipe"; |
67 | close READER; |
68 | |
69 | $SIG{'PIPE'} = 'broken_pipe'; |
70 | |
71 | sub broken_pipe { |
1d2dff63 |
72 | $SIG{'PIPE'} = 'IGNORE'; # loop preventer |
ac58e20f |
73 | print "ok 7\n"; |
74 | } |
75 | |
76 | print WRITER "not ok 7\n"; |
77 | close WRITER; |
3d57aefb |
78 | sleep 1; |
ac58e20f |
79 | print "ok 8\n"; |
03136e13 |
80 | |
81 | # VMS doesn't like spawning subprocesses that are still connected to |
1d3434b8 |
82 | # STDOUT. Someone should modify tests #9 to #12 to work with VMS. |
03136e13 |
83 | |
84 | if ($^O eq 'VMS') { |
85 | print "ok 9\n"; |
86 | print "ok 10\n"; |
1d3434b8 |
87 | print "ok 11\n"; |
88 | print "ok 12\n"; |
03136e13 |
89 | exit; |
90 | } |
91 | |
e5e1b98b |
92 | if ($Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || $^O eq 'posix-bc') { |
03136e13 |
93 | # Sfio doesn't report failure when closing a broken pipe |
fc261528 |
94 | # that has pending output. Go figure. MachTen doesn't either, |
95 | # but won't write to broken pipes, so nothing's pending at close. |
6ee623d5 |
96 | # BeOS will not write to broken pipes, either. |
e5e1b98b |
97 | # Nor does POSIX-BC. |
03136e13 |
98 | print "ok 9\n"; |
99 | } |
100 | else { |
101 | local $SIG{PIPE} = 'IGNORE'; |
102 | open NIL, '|true' or die "open failed: $!"; |
103 | sleep 2; |
104 | print NIL 'foo' or die "print failed: $!"; |
105 | if (close NIL) { |
106 | print "not ok 9\n"; |
107 | } |
108 | else { |
109 | print "ok 9\n"; |
110 | } |
111 | } |
112 | |
092bebab |
113 | if ($^O eq 'vmesa') { |
114 | # These don't work, yet. |
115 | print "ok 10\n"; |
116 | print "ok 11\n"; |
117 | print "ok 12\n"; |
118 | exit; |
119 | } |
120 | |
03136e13 |
121 | # check that errno gets forced to 0 if the piped program exited non-zero |
122 | open NIL, '|exit 23;' or die "fork failed: $!"; |
123 | $! = 1; |
124 | if (close NIL) { |
125 | print "not ok 10\n# successful close\n"; |
126 | } |
127 | elsif ($! != 0) { |
128 | print "not ok 10\n# errno $!\n"; |
129 | } |
130 | elsif ($? == 0) { |
131 | print "not ok 10\n# status 0\n"; |
132 | } |
133 | else { |
134 | print "ok 10\n"; |
135 | } |
1d3434b8 |
136 | |
137 | # check that status for the correct process is collected |
062dddbe |
138 | wait; # Collect from $pid |
1d3434b8 |
139 | my $zombie = fork or exit 37; |
140 | my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n"; |
141 | $SIG{ALRM} = sub { return }; |
142 | alarm(1); |
143 | my $close = close FH; |
144 | if ($? == 13*256 && ! length $close && ! $!) { |
145 | print "ok 11\n"; |
146 | } else { |
147 | print "not ok 11\n# close $close\$?=$? \$!=", $!+0, ":$!\n"; |
148 | }; |
149 | my $wait = wait; |
150 | if ($? == 37*256 && $wait == $zombie && ! $!) { |
151 | print "ok 12\n"; |
152 | } else { |
062dddbe |
153 | print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$? \$!=", $!+0, ":$!\n"; |
1d3434b8 |
154 | } |