Forks-Super

 view release on metacpan or  search on metacpan

t/41c-filehandles.t  view on Meta::CPAN

	    exit if $_ eq "__END__";
	    print "$_\\", unpack("%32C*",$_)%65535,"\n";
	}
	# <STDIN> might not be ready right away.
	sleep 1;
    }
}

my @pids = ();
my @data = (@INC,%INC,%!,0..19)[0..19];
my (@pdata, @cdata);
for (my $i=0; $i<4; $i++) {
    push @pids, 
    fork { 
	sub => \&compute_checksums_in_child, 
	child_fh => "in,out" 
    };
}
for (my $i=0; $i<@data; $i++) {
    Forks::Super::write_stdin $pids[$i%4], "$data[$i]\n";
    push @pdata, sprintf("%s\\%d\n", 
			 $data[$i], unpack("%32C*",$data[$i])%65535);
}
Forks::Super::write_stdin($_,"__END__\n") for @pids;
waitall;

foreach (@pids) {
    push @cdata, Forks::Super::read_stdout($_);
}
ok(@pdata == @cdata,                                              ### 1 ###
   "Master/slave produced ".scalar @pdata."/".scalar @cdata." lines")
 or do {
     no warnings 'uninitialized';
     print STDERR "\@pdata: @pdata[0..19]\n";
     print STDERR "--------------\n\@cdata: ",
         join ' ', map { $_ || '"undef"' . "\n" } @cdata[0..19], "\n";
};

@pdata = sort grep defined,@pdata;
@cdata = sort grep defined,@cdata;
my $pc_equal = 1;
for (my $i=0; $i<@pdata; $i++) {
    if (!defined($pdata[$i]) || !defined($cdata[$i])
	    || $pdata[$i] ne $cdata[$i]) {
	$pc_equal=0 
    }
}
ok($pc_equal, "master/slave produced same data"); ### 22 ###

##########################################################

t/43d-sockethandles.t  view on Meta::CPAN

	      timeout => 30,
	      child_fh => "in,out,socket"
	  });
}

# there is a SIGPIPE somewhere here that causes intermittent failures 
# (see www.cpantesters.org/cpan/report/b2d2eb00-6ec0-11e0-ab3a-49fa30e3b300)
# include some diag() statements to help track it down ...

my @data = (@INC,%INC,keys(%!),keys(%ENV),0..99)[0 .. 99];
my (@pdata, @cdata);


# SIGPIPE indicates that the child process has died, and that
# the remainder of this test will not go well.
my $sigpipes_caught = 0;
my $active_pid;
$SIG{PIPE} = sub { 
    if (++$sigpipes_caught =~ /[1-9](0|$)/) {
	diag("SIGPIPE caught, pid $active_pid: $sigpipes_caught");
    }

t/43d-sockethandles.t  view on Meta::CPAN

for my $pid (@pids) {
    $active_pid = $pid;
    Forks::Super::write_stdin($pid, "__END__\r\n");
    Forks::Super::write_stdin($pid, "__END__\r\n");
    $pid->close_fh('stdin');
}

waitall;

foreach (@pids) {
    push @cdata, Forks::Super::read_stdout($_);
}
ok(@pdata > 0 && @cdata >= @pdata,                         ### 1 ###
   "$$\\parent & child processed " .(scalar @pdata)
   ."/".(scalar @cdata)." strings");
@pdata = sort @pdata;
@cdata = sort @cdata;
my $pc_equal = 1;
for (my $i=0; $i<@cdata; $i++) {
    no warnings 'uninitialized';
    if ($pdata[$i] ne $cdata[$i]) {
	$pc_equal = 0;
    }
}
ok($pc_equal, "parent/child agree on output");

#######################################################################

# 

t/44d-pipes.t  view on Meta::CPAN

my @pids = ();
for (my $i=0; $i<4; $i++) {
    # v0.33: list context may be supported
    push @pids, scalar fork { 
	sub => \&compute_checksums_in_child, 
	timeout => 30,
	child_fh => "in,out,pipe" 
    };
}
my @data = (@INC,%INC,keys(%!),keys(%ENV),0..199)[0..199];
my (@pdata, @cdata);
for (my $i=0; $i<@data; $i++) {
    $pids[$i % 4]->write_stdin("$data[$i]\n");
    push @pdata, sprintf("%s\\%d\n", $data[$i],
                         unpack("%32C*",$data[$i])%65535);
}
Forks::Super::write_stdin($_,"__END__\n") for @pids;
$_->close_fh('stdin') foreach @pids;

waitall;
foreach (@pids) {
    push @cdata, Forks::Super::read_stdout($_);
}


ok(@pdata > 0 && @pdata == @cdata, "$$\\parent & child processed "
   .(scalar @pdata)."/".(scalar @cdata)." strings");
@pdata = sort @pdata;
@cdata = sort @cdata;
my $pc_equal = 1;
for (my $i=0; $i<@pdata; $i++) {
    $pc_equal=0 
	if $pdata[$i] ne $cdata[$i] 
	    && print "$i: $pdata[$i] /// $cdata[$i] ///\n";
}
ok($pc_equal, "parent/child agree on output");

#######################################################################