| #!./perl |
| |
| my $perl; |
| |
| BEGIN { |
| $perl = $^X; |
| } |
| |
| use Config; |
| |
| BEGIN { |
| my $can_fork = $Config{d_fork} || |
| (($^O eq 'MSWin32' || $^O eq 'NetWare') and |
| $Config{useithreads} and |
| $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ |
| ); |
| my $reason; |
| if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) { |
| $reason = 'IO extension unavailable'; |
| } |
| elsif (!$can_fork) { |
| $reason = 'no fork'; |
| } |
| elsif ($^O eq 'MSWin32' && !$ENV{TEST_IO_PIPE}) { |
| $reason = 'Win32 testing environment not set'; |
| } |
| if ($reason) { |
| print "1..0 # Skip: $reason\n"; |
| exit 0; |
| } |
| } |
| |
| use IO::Pipe; |
| |
| my $is_win32=$^O eq 'MSWin32' ? "MSWin32 has broken pipes" : ""; |
| |
| $| = 1; |
| print "1..10\n"; |
| |
| if ($is_win32) { |
| print "ok $_ # skipped: $is_win32\n" for 1..4; |
| } else { |
| $pipe = new IO::Pipe->reader($perl, '-e', 'print qq(not ok 1\n)'); |
| while (<$pipe>) { |
| s/^not //; |
| print; |
| } |
| $pipe->close or print "# \$!=$!\nnot "; |
| print "ok 2\n"; |
| $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //'; |
| $pipe = new IO::Pipe->writer($perl, '-pe', $cmd); |
| print $pipe "not ok 3\n" ; |
| $pipe->close or print "# \$!=$!\nnot "; |
| print "ok 4\n"; |
| } |
| |
| # Check if can fork with dynamic extensions (bug in CRT): |
| if ($^O eq 'os2' and |
| system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") { |
| print "ok $_ # skipped: broken fork\n" for 5..10; |
| exit 0; |
| } |
| |
| $pipe = new IO::Pipe; |
| |
| $pid = fork(); |
| |
| if($pid) |
| { |
| $pipe->writer; |
| print $pipe "Xk 5\n"; |
| print $pipe "oY 6\n"; |
| $pipe->close; |
| wait; |
| } |
| elsif(defined $pid) |
| { |
| $pipe->reader; |
| $stdin = bless \*STDIN, "IO::Handle"; |
| $stdin->fdopen($pipe,"r"); |
| exec $^X, '-pne', 'tr/YX/ko/'; |
| } |
| else |
| { |
| die "# error = $!"; |
| } |
| |
| if ($is_win32) { |
| print "ok $_ # skipped: $is_win32\n" for 7..8; |
| } else { |
| $pipe = new IO::Pipe; |
| $pid = fork(); |
| |
| if($pid) |
| { |
| $pipe->reader; |
| while(<$pipe>) { |
| s/^not //; |
| print; |
| } |
| $pipe->close; |
| wait; |
| } |
| elsif(defined $pid) |
| { |
| $pipe->writer; |
| |
| $stdout = bless \*STDOUT, "IO::Handle"; |
| $stdout->fdopen($pipe,"w"); |
| print STDOUT "not ok 7\n"; |
| exec 'echo', 'not ok 8'; |
| } |
| else |
| { |
| die; |
| } |
| } |
| if ($is_win32) { |
| print "ok $_ # skipped: $is_win32\n" for 9; |
| } else { |
| $pipe = new IO::Pipe; |
| $pipe->writer; |
| |
| $SIG{'PIPE'} = 'broken_pipe'; |
| |
| sub broken_pipe { |
| print "ok 9\n"; |
| } |
| |
| print $pipe "not ok 9\n"; |
| $pipe->close; |
| |
| sleep 1; |
| } |
| print "ok 10\n"; |
| |