io_pipe.t

来自「source of perl for linux application,」· T 代码 · 共 144 行

#!./perl

my $perl;

BEGIN {
    unless(grep /blib/, @INC) {
	$perl = './perl';
	chdir 't' if -d 't';
	@INC = '../lib';
    }
    else {
	$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";