From: Vincent Pit Date: Thu, 26 Mar 2009 00:46:11 +0000 (+0100) Subject: Test unwind in threads X-Git-Tag: v0.08~2 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=3a414dec45c3c2519b8384e8d81a986e9b76329f;p=perl%2Fmodules%2FScope-Upper.git Test unwind in threads --- diff --git a/MANIFEST b/MANIFEST index 158b3a0..b74a7ca 100644 --- a/MANIFEST +++ b/MANIFEST @@ -30,6 +30,7 @@ t/44-localize_delete-magic.t t/50-unwind-target.t t/55-unwind-multi.t t/56-unwind-context.t +t/59-unwind-threads.t t/81-stress-level.t t/85-stress-unwind.t t/90-boilerplate.t diff --git a/t/59-unwind-threads.t b/t/59-unwind-threads.t new file mode 100644 index 0000000..30e16d3 --- /dev/null +++ b/t/59-unwind-threads.t @@ -0,0 +1,72 @@ +#!perl -T + +use strict; +use warnings; + +sub skipall { + my ($msg) = @_; + require Test::More; + Test::More::plan(skip_all => $msg); +} + +use Config qw/%Config/; + +BEGIN { + skipall 'This perl wasn\'t built to support threads' + unless $Config{useithreads}; + skipall 'threads required to test thread safety' unless eval "use threads; 1"; +} + +my $num; +BEGIN { $num = 20; } + +use Test::More tests => $num; + +BEGIN { + defined and diag "Using threads $_" for $threads::VERSION; + + if (eval "use Time::HiRes; 1") { + defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION; + *usleep = \&Time::HiRes::usleep; + } else { + diag 'Using fallback usleep'; + *usleep = sub { + my $s = int($_[0] / 2.5e5); + sleep $s if $s; + }; + } +} + +use Scope::Upper qw/unwind UP/; + +our $z; + +BEGIN { +} + +sub up1 { + my $tid = threads->tid(); + local $z = $tid; + my $p = "[$tid] up1"; + + usleep rand(1e6); + + my @res = ( + -1, + sub { + my @dummy = ( + 999, + sub { + my $foo = unwind $tid .. $tid + 2 => UP; + fail "$p: not reached"; + }->() + ); + fail "$p: not reached"; + }->(), + -2 + ); + + is_deeply \@res, [ -1, $tid .. $tid + 2, -2 ], "$p: unwinded correctly"; +} + +$_->join for map threads->create(\&up1), 1 .. $num;