X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F30-threads.t;h=73359c3da8c727c364c7eecd9f01b92eed6ce327;hb=a838a3bf0d49fcb56ea57da58771d2e2c77bfc26;hp=5c4b8d1710a3f587a552b6f3e1d8dfa404bf3edc;hpb=311cc872692b73075296805143f6a2d8c4074254;p=perl%2Fmodules%2FLexical-Types.git diff --git a/t/30-threads.t b/t/30-threads.t index 5c4b8d1..73359c3 100644 --- a/t/30-threads.t +++ b/t/30-threads.t @@ -3,19 +3,13 @@ use strict; use warnings; -use Config qw/%Config/; +use lib 't/lib'; +use Lexical::Types::TestThreads; -BEGIN { - if (!$Config{useithreads}) { - require Test::More; - Test::More->import; - plan(skip_all => 'This perl wasn\'t built to support threads'); - } -} +use Test::More 'no_plan'; -use threads; - -use Test::More tests => 10 * 2 * 2 * (1 + 2); +my $threads = 10; +my $runs = 2; { package Lexical::Types::Test::Tag; @@ -24,6 +18,7 @@ use Test::More tests => 10 * 2 * 2 * (1 + 2); 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; @@ -38,7 +33,7 @@ use Lexical::Types as => 'Lexical::Types::Test::'; sub try { my $tid = threads->tid(); - for (1 .. 2) { + for (1 .. $runs) { my Tag $t; is $t, $tid, "typed lexical correctly initialized at run $_ in thread $tid"; @@ -48,8 +43,21 @@ sub try { 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 + } } } -my @t = map threads->create(\&try), 1 .. 10; +my @t = map spawn(\&try), 1 .. $threads; + $_->join for @t; + +pass 'done';