This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make tests succeed on OS/2
[perl5.git] / t / lib / io_pipe.t
CommitLineData
61f2b451 1#!./perl
2
3BEGIN {
7a4c00b4 4 unless(grep /blib/, @INC) {
5 chdir 't' if -d 't';
6 @INC = '../lib' if -d '../lib';
7 }
8}
9
10use Config;
11
12BEGIN {
13 if(-d "lib" && -f "TEST") {
774d564b 14 if (! $Config{'d_fork'} ||
15 ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS'))
16 {
7a4c00b4 17 print "1..0\n";
18 exit 0;
19 }
61f2b451 20 }
21}
22
23use IO::Pipe;
24
774d564b 25my $perl = './perl';
26
61f2b451 27$| = 1;
774d564b 28print "1..10\n";
29
30$pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"');
31while (<$pipe>) {
32 s/^not //;
33 print;
34}
35$pipe->close or print "# \$!=$!\nnot ";
36print "ok 2\n";
37
38$cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //';
39$pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
40print $pipe "not ok 3\n" ;
41$pipe->close or print "# \$!=$!\nnot ";
42print "ok 4\n";
61f2b451 43
a245ea2d
IZ
44# Check if can fork with dynamic extensions (bug in CRT):
45if ($^O eq 'os2' and
46 system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") {
47 print "ok $_ # skipped: broken fork\n" for 5..10;
48 exit 0;
49}
50
61f2b451 51$pipe = new IO::Pipe;
52
53$pid = fork();
54
55if($pid)
56 {
57 $pipe->writer;
774d564b 58 print $pipe "Xk 5\n";
59 print $pipe "oY 6\n";
61f2b451 60 $pipe->close;
61 wait;
62 }
63elsif(defined $pid)
64 {
65 $pipe->reader;
66 $stdin = bless \*STDIN, "IO::Handle";
67 $stdin->fdopen($pipe,"r");
68 exec 'tr', 'YX', 'ko';
69 }
70else
71 {
774d564b 72 die "# error = $!";
61f2b451 73 }
74
75$pipe = new IO::Pipe;
76$pid = fork();
77
78if($pid)
79 {
80 $pipe->reader;
81 while(<$pipe>) {
82 s/^not //;
83 print;
84 }
85 $pipe->close;
86 wait;
87 }
88elsif(defined $pid)
89 {
90 $pipe->writer;
91
92 $stdout = bless \*STDOUT, "IO::Handle";
93 $stdout->fdopen($pipe,"w");
774d564b 94 print STDOUT "not ok 7\n";
95 exec 'echo', 'not ok 8';
61f2b451 96 }
97else
98 {
99 die;
100 }
101
102$pipe = new IO::Pipe;
103$pipe->writer;
104
105$SIG{'PIPE'} = 'broken_pipe';
106
107sub broken_pipe {
774d564b 108 print "ok 9\n";
61f2b451 109}
110
774d564b 111print $pipe "not ok 9\n";
61f2b451 112$pipe->close;
113
3d57aefb 114sleep 1;
61f2b451 115
774d564b 116print "ok 10\n";
61f2b451 117