Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
IO.t	2.59 KB	-r--r--r--	2014-12-27 11:48
cachepropagate-tcp.t	1.3 KB	-r--r--r--	2014-12-27 11:48
cachepropagate-udp.t	1.14 KB	-r--r--r--	2014-12-27 11:48
cachepropagate-unix.t	2.87 KB	-r--r--r--	2014-12-27 11:48
io_const.t	577 B	-r--r--r--	2014-12-27 11:48
io_dir.t	1.42 KB	-r--r--r--	2014-12-27 11:48
io_dup.t	1.17 KB	-r--r--r--	2014-12-27 11:48
io_file.t	1.33 KB	-r--r--r--	2014-12-27 11:48
io_file_export.t	517 B	-r--r--r--	2014-12-27 11:48
io_linenum.t	1.26 KB	-r--r--r--	2014-12-27 11:49
io_multihomed.t	2.2 KB	-r--r--r--	2014-12-27 11:48
io_pipe.t	2.54 KB	-r--r--r--	2014-12-27 11:48
io_poll.t	1.36 KB	-r--r--r--	2014-12-27 11:48
io_sel.t	3.21 KB	-r--r--r--	2014-12-27 11:48
io_sock.t	8.78 KB	-r--r--r--	2014-12-27 11:48
io_taint.t	1.29 KB	-r--r--r--	2014-12-27 11:49
io_tell.t	1.36 KB	-r--r--r--	2014-12-27 11:48
io_udp.t	1.99 KB	-r--r--r--	2014-12-27 11:48
io_unix.t	2.41 KB	-r--r--r--	2014-12-27 11:48
io_utf8.t	833 B	-r--r--r--	2014-12-27 11:48
io_utf8argv.t	939 B	-r--r--r--	2014-12-27 11:48
io_xs.t	1.29 KB	-r--r--r--	2014-12-27 12:38

Rename

#!./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";
  my @echo = 'echo';
  if ( $^O =~ /android/ ) {
     @echo = ('sh', '-c', q{echo $@}, '--');
  }
  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";