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