From: Peter Rabbitson Date: Wed, 13 Apr 2016 17:43:30 +0000 (+0200) Subject: Fix thinko from 10dd5c05 - make sure we actually sleep X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ef25a42942e8454e0285a9f42a567327fbd96496;p=dbsrgits%2FDBIx-Class.git Fix thinko from 10dd5c05 - make sure we actually sleep Under very tight concurrency it is possible that the test will not be given sufficient timeshare before the scheduled 'point in the future', which would result in us asking Time::HiRes to sleep for a negative amount of time, which it "helpfully" converts to an obnoxious exception. --- diff --git a/t/50fork.t b/t/50fork.t index 244bf2a..229a4f2 100644 --- a/t/50fork.t +++ b/t/50fork.t @@ -6,6 +6,7 @@ use warnings; use Test::More; use Test::Exception; use Time::HiRes qw(time sleep); +use List::Util 'max'; use DBICTest; @@ -107,7 +108,7 @@ while(@pids < $num_children) { $pid = $$; - sleep ( $t - time ); + sleep( max( 0.1, $t - time ) ); note ("Child process $pid starting work at " . time() ); my $work = sub { diff --git a/t/51threads.t b/t/51threads.t index be0b1d6..d5cd0d5 100644 --- a/t/51threads.t +++ b/t/51threads.t @@ -22,6 +22,7 @@ use warnings; use Test::More; use Test::Exception; use Time::HiRes qw(time sleep); +use List::Util 'max'; plan skip_all => 'DBIC does not actively support threads before perl 5.8.5' if "$]" < 5.008005; @@ -115,7 +116,7 @@ while(@children < $num_children) { my $newthread = async { my $tid = threads->tid; - sleep ($t - time); + sleep( max( 0.1, $t - time ) ); # FIXME if we do not stagger the threads, sparks fly due to CXSA sleep ( $tid / 10 ) if "$]" < 5.012; diff --git a/t/51threadtxn.t b/t/51threadtxn.t index 52a6966..6c781e5 100644 --- a/t/51threadtxn.t +++ b/t/51threadtxn.t @@ -29,6 +29,7 @@ plan skip_all => 'DBIC does not actively support threads before perl 5.8.5' use Scalar::Util 'weaken'; use Time::HiRes qw(time sleep); +use List::Util 'max'; use DBICTest; @@ -70,7 +71,7 @@ while(@children < $num_children) { my $newthread = async { my $tid = threads->tid; - sleep ($t - time); + sleep( max( 0.1, $t - time ) ); # FIXME if we do not stagger the threads, sparks fly due to CXSA sleep ( $tid / 10 ) if "$]" < 5.012; diff --git a/xt/extra/internals/ithread_stress.t b/xt/extra/internals/ithread_stress.t index c1d46f2..0b1602f 100644 --- a/xt/extra/internals/ithread_stress.t +++ b/xt/extra/internals/ithread_stress.t @@ -54,6 +54,7 @@ use Test::More; use Errno (); use DBIx::Class::_Util 'sigwarn_silencer'; use Time::HiRes qw(time sleep); +use List::Util 'max'; # README: If you set the env var to a number greater than 5, # we will use that many children @@ -78,7 +79,7 @@ SKIP: { push @threads, threads->create(sub { my $tid = threads->tid; - sleep ($t - time); + sleep( max( 0.1, $t - time ) ); note ("Thread $tid starting work at " . time() ); my $rsrc = $schema->source('Artist');