This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix various details in win32 makefiles and Config.pm setup.
[perl5.git] / t / io / pipe.t
1 #!./perl
2
3 # $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $
4
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
15 $| = 1;
16 print "1..10\n";
17
18 open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
19 print PIPE "Xk 1\n";
20 print PIPE "oY 2\n";
21 close PIPE;
22
23 if (open(PIPE, "-|")) {
24     while(<PIPE>) {
25         s/^not //;
26         print;
27     }
28 }
29 else {
30     print STDOUT "not ok 3\n";
31     exec 'echo', 'not ok 4';
32 }
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;
65
66 print "ok 8\n";
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
77 if ($Config{d_sfio} || $^O eq machten) {
78     # Sfio doesn't report failure when closing a broken pipe
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.
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 }