From: Peter Rabbitson Date: Sat, 29 Dec 2012 10:52:10 +0000 (+0100) Subject: Make sure to abort the test if a thread dies X-Git-Tag: v0.03~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e38f78849d41e0c2f626dd01adc40efb0493dfc7;p=p5sagit%2FDevel-PeekPoke.git Make sure to abort the test if a thread dies --- diff --git a/t/04thread-torture.t b/t/04thread-torture.t index 2424aae..fa35099 100644 --- a/t/04thread-torture.t +++ b/t/04thread-torture.t @@ -19,8 +19,12 @@ $|++; # seems to be critical share $::TEST_COUNT; # older perls crash if threads are spawned way too quickly, sleep for 100 msecs -my @pool = map { sleep 0.1 and threads->create(\&run_torture) } (1..10); -$_->join for @pool; +my @pool = map { sleep 0.1 and threads->create(\&run_torture) } (1..($ENV{AUTOMATED_TESTING} ? 20 : 5) ); +for (@pool) { + if ($_->join != 42) { + die ($_->can('error') ? $_->error : "Thread did not finish successfully" ); + } +} if ($ENV{AUTOMATED_TESTING}) { my $vsz; @@ -37,7 +41,7 @@ if ($ENV{AUTOMATED_TESTING}) { print "1..$::TEST_COUNT\n"; sub run_torture { - my $src = do { local (@ARGV, $/) = 't/03torture.t'; <>; }; - eval $src; + do 't/03torture.t'; die $@ if $@ ne ''; + 42; }