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; |
03136e13 |
16 | print "1..10\n"; |
378cc40b |
17 | |
c07a80fd |
18 | open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); |
19 | print PIPE "Xk 1\n"; |
20 | print PIPE "oY 2\n"; |
378cc40b |
21 | close PIPE; |
22 | |
23 | if (open(PIPE, "-|")) { |
24 | while(<PIPE>) { |
ac58e20f |
25 | s/^not //; |
378cc40b |
26 | print; |
27 | } |
28 | } |
29 | else { |
ac58e20f |
30 | print STDOUT "not ok 3\n"; |
31 | exec 'echo', 'not ok 4'; |
378cc40b |
32 | } |
ac58e20f |
33 | |
34 | pipe(READER,WRITER) || die "Can't open pipe"; |
35 | |
36 | if ($pid = fork) { |
37 | close WRITER; |
38 | while(<READER>) { |
39 | s/^not //; |
40 | y/A-Z/a-z/; |
41 | print; |
42 | } |
43 | } |
44 | else { |
45 | die "Couldn't fork" unless defined $pid; |
46 | close READER; |
47 | print WRITER "not ok 5\n"; |
48 | open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT"; |
49 | close WRITER; |
50 | exec 'echo', 'not ok 6'; |
51 | } |
52 | |
53 | |
54 | pipe(READER,WRITER) || die "Can't open pipe"; |
55 | close READER; |
56 | |
57 | $SIG{'PIPE'} = 'broken_pipe'; |
58 | |
59 | sub broken_pipe { |
60 | print "ok 7\n"; |
61 | } |
62 | |
63 | print WRITER "not ok 7\n"; |
64 | close WRITER; |
3d57aefb |
65 | sleep 1; |
ac58e20f |
66 | print "ok 8\n"; |
03136e13 |
67 | |
68 | # VMS doesn't like spawning subprocesses that are still connected to |
69 | # STDOUT. Someone should modify tests #9 and #10 to work with VMS. |
70 | |
71 | if ($^O eq 'VMS') { |
72 | print "ok 9\n"; |
73 | print "ok 10\n"; |
74 | exit; |
75 | } |
76 | |
fc261528 |
77 | if ($Config{d_sfio} || $^O eq machten) { |
03136e13 |
78 | # Sfio doesn't report failure when closing a broken pipe |
fc261528 |
79 | # that has pending output. Go figure. MachTen doesn't either, |
80 | # but won't write to broken pipes, so nothing's pending at close. |
03136e13 |
81 | print "ok 9\n"; |
82 | } |
83 | else { |
84 | local $SIG{PIPE} = 'IGNORE'; |
85 | open NIL, '|true' or die "open failed: $!"; |
86 | sleep 2; |
87 | print NIL 'foo' or die "print failed: $!"; |
88 | if (close NIL) { |
89 | print "not ok 9\n"; |
90 | } |
91 | else { |
92 | print "ok 9\n"; |
93 | } |
94 | } |
95 | |
96 | # check that errno gets forced to 0 if the piped program exited non-zero |
97 | open NIL, '|exit 23;' or die "fork failed: $!"; |
98 | $! = 1; |
99 | if (close NIL) { |
100 | print "not ok 10\n# successful close\n"; |
101 | } |
102 | elsif ($! != 0) { |
103 | print "not ok 10\n# errno $!\n"; |
104 | } |
105 | elsif ($? == 0) { |
106 | print "not ok 10\n# status 0\n"; |
107 | } |
108 | else { |
109 | print "ok 10\n"; |
110 | } |