diff --git a/Build.PL b/Build.PL index ad9d29b..92f7a60 100644 --- a/Build.PL +++ b/Build.PL @@ -48,8 +48,9 @@ my %args = ( script_files => [glob('script/*'), glob('bin/*')], PL_files => {}, - test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/', + test_files => 't/02_parallel.t', recursive_test_files => 1, + verbose => 1, ); diff --git a/run_coverage.sh b/run_coverage.sh new file mode 100755 index 0000000..feaf7f4 --- /dev/null +++ b/run_coverage.sh @@ -0,0 +1,11 @@ +#!/bin/bash -e +count=0; +perl Build.PL + +while true; do + count=$(($count + 1 )); + echo "LOOP $count"; + TEST_SHARED=1 TEST_SUBREAPER=1 cover -test -report codecovbash +# TEST_SHARED=1 TEST_SUBREAPER=1 cover -test -report text +done + diff --git a/t/02_parallel.t b/t/02_parallel.t index 6f3c52c..fa1963a 100644 --- a/t/02_parallel.t +++ b/t/02_parallel.t @@ -5,23 +5,31 @@ use strict; use Test::More; use POSIX; use FindBin; +use Time::HiRes qw(sleep); use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(parallel batch process pool); +my $sleepduration = 0; + +my $session = Mojo::IOLoop::ReadWriteProcess::Session->new(); +$session->emit_from_sigchld(0); + subtest parallel => sub { my $n_proc = 4; my $fired; my $c = parallel( - code => sub { sleep 2; print "Hello world\n"; }, - kill_sleeptime => 1, + code => sub { sleep $sleepduration; print "Hello world\n"; }, + kill_sleeptime => 1, sleeptime_during_kill => 1, separate_err => 1, set_pipes => 1, $n_proc ); + is ($session, $c->first->session, "Session is the singleton!"); + isa_ok($c, "Mojo::IOLoop::ReadWriteProcess::Pool"); is $c->size(), $n_proc; @@ -34,7 +42,7 @@ subtest parallel => sub { $c->once(stop => sub { $fired++ }); my $b = $c->restart(); is $b, $c; - sleep 3; + sleep $sleepduration * 3; $c->wait_stop; is $fired, $n_proc * 2; }; @@ -47,7 +55,7 @@ subtest batch => sub { push( @stack, process( - code => sub { sleep 2; print "Hello world\n" }, + code => sub { sleep $sleepduration; print "Hello world\n" }, separate_err => 0, set_pipes => 1 )) for (1 .. $n_proc); @@ -71,8 +79,8 @@ subtest batch => sub { set_pipes => 1 ); $c->start(); - is $c->last->getline, "Hello world 3\n"; $c->wait_stop(); + is $c->last->getline, "Hello world 3\n"; my $result; $c->add(code => sub { return 40 + 2 }, separate_err => 0, set_pipes => 0); @@ -93,7 +101,7 @@ subtest "Working with pools" => sub { code => sub { my $self = shift; my $number = shift; - sleep 2; + sleep $sleepduration; return 40 + $number; }, args => $number, @@ -138,7 +146,7 @@ subtest stress_test => sub { my $p = pool; $p->maximum_processes($n_proc); $p->add( - code => sub { sleep 3; exit(20) }, + code => sub { sleep $sleepduration * 3; exit(20) }, internal_pipes => 0, set_pipes => 0 ) for 1 .. $n_proc; diff --git a/t/14_sig_on_io.t b/t/14_sig_on_io.t new file mode 100644 index 0000000..7ce2dd0 --- /dev/null +++ b/t/14_sig_on_io.t @@ -0,0 +1,28 @@ +#!/usr/bin/perl + +use Mojo::Base -strict; +use Test::More; +use Time::HiRes qw(sleep); +use FindBin; +use lib ("$FindBin::Bin/lib", "../lib", "lib"); +use Mojo::IOLoop::ReadWriteProcess qw(process batch); +use Data::Dumper; + +my $sleepduration = 0; + +subtest "Signal on IO" => sub { + my @stack; + + my $p1 = process(sub { sleep 2; print "Hello world\n" }); + for my $i (1 .. 10) { + push (@stack, process(sub { sleep 0.2 * $i; print "Bye Bye"})) + } + my $c = batch @stack; + + $p1->start; + $c->start(); + is ($p1->getline(), "Hello world\n", "P1 can read with signals received!"); + is (!!$!{EINTR}, 1, "EINTR is set"); +}; + +done_testing;