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