9 Test::More::plan(skip_all => $msg);
12 use Config qw<%Config>;
15 my $force = $ENV{PERL_INDIRECT_TEST_THREADS} ? 1 : !1;
16 skipall 'This perl wasn\'t built to support threads'
17 unless $Config{useithreads};
18 skipall 'perl 5.13.4 required to test thread safety'
19 unless $force or $] >= 5.013004;
27 delete $ENV{PERL_INDIRECT_PM_DISABLE};
29 skipall 'This indirect isn\'t thread safe' unless indirect::I_THREADSAFE();
30 plan tests => 10 * 2 * (2 + 3);
31 defined and diag "Using threads $_" for $threads::VERSION;
36 qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/;
43 my $tid = threads->tid();
47 my $class = "Coconut$tid";
50 local $SIG{__WARN__} = sub { push @warns, @_ };
51 eval 'die "the code compiled but it shouldn\'t have\n";
52 no indirect ":fatal"; my $x = new ' . $class . ' 1, 2;';
54 like $@ || '', expect($class),
55 "\"no indirect\" in eval in thread $tid died as expected";
56 is_deeply \@warns, [ ],
57 "\"no indirect\" in eval in thread $tid didn't warn";
62 skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3
64 my $class = "Pineapple$tid";
67 local $SIG{__WARN__} = sub { push @warns, @_ };
68 eval 'return; my $y = new ' . $class . ' 1, 2;';
71 "\"no indirect\" propagated into eval in thread $tid didn't croak";
72 my $first = shift @warns;
73 like $first || '', expect($class),
74 "\"no indirect\" propagated into eval in thread $tid warned once";
75 is_deeply \@warns, [ ],
76 "\"no indirect\" propagated into eval in thread $tid warned just once";
82 my @t = map threads->create(\&try), 1 .. 10;