X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F30-threads.t;h=aa42d69f98c19ef1daa793b6fdfb3048a148956b;hb=c530c61ff04bdbd8bc101a3e88273fc4219d963e;hp=d3dcc3b644b8d29d471bf1ca123681635df70002;hpb=06cb3f3506161a118dc440264dcabcd612b9432c;p=perl%2Fmodules%2FLexical-Types.git diff --git a/t/30-threads.t b/t/30-threads.t index d3dcc3b..aa42d69 100644 --- a/t/30-threads.t +++ b/t/30-threads.t @@ -15,12 +15,31 @@ BEGIN { use threads; -use Test::More tests => 10 * 2; +use Test::More; + +BEGIN { + require Lexical::Types; + if (Lexical::Types::LT_THREADSAFE()) { + plan tests => 10 * 2 * 3 * (1 + 2); + defined and diag "Using threads $_" for $threads::VERSION; + } else { + plan skip_all => 'This Lexical::Types isn\'t thread safe'; + } +} { package Lexical::Types::Test::Tag; - sub TYPEDSCALAR { $_[1] = threads->tid() } + sub TYPEDSCALAR { + my $tid = threads->tid(); + my ($file, $line) = (caller(0))[1, 2]; + my $where = "at $file line $line in thread $tid"; + local $Test::Builder::Level = $Test::Builder::Level + 1; + Test::More::is($_[0], __PACKAGE__, "base type is correct $where"); + Test::More::is($_[2], 'Tag', "original type is correct $where"); + $_[1] = $tid; + (); + } } { package Tag; } @@ -28,10 +47,28 @@ use Test::More tests => 10 * 2; use Lexical::Types as => 'Lexical::Types::Test::'; sub try { + my $tid = threads->tid(); + for (1 .. 2) { my Tag $t; - my $tid = threads->tid(); is $t, $tid, "typed lexical correctly initialized at run $_ in thread $tid"; + + eval <<'EVALD'; + use Lexical::Types as => "Lexical::Types::Test::"; + my Tag $t2; + is $t2, $tid, "typed lexical correctly initialized in eval at run $_ in thread $tid"; +EVALD + diag $@ if $@; + +SKIP: + { + skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 + unless $] >= 5.010; + eval <<'EVALD'; + my Tag $t3; + is $t3, $tid, "typed lexical correctly initialized in eval (propagated) at run $_ in thread $tid" +EVALD + } } }